Excel 技巧：根據列值將數據分割到多個工作表 / 工作簿中

在 Excel 中管理大型數據集時，根據特定列值將數據分割到多個工作表中會非常有幫助。這種方法不僅能改善數據的組織方式，還能提高可讀性並促進更便捷的數據分析。

假設您有一份包含多條記錄的大批量銷售數據，例如產品名稱和第一季度的銷售數量。目標是根據每個產品名稱將這些數據分割到不同的工作表中，以便單獨分析每種產品的銷售表現。

根據列值將數據分割到多個工作表中

• 通過使用 VBA 程式碼
• 通過使用強大的功能 - Kutools for Excel

使用 VBA 程式碼根據列值將數據分割到多個工作簿中

根據列值將數據分割到多個工作表中

通常情況下，您可以先對數據列表進行排序，然後逐一複製並將其粘貼到其他新工作表中。但這需要您耐心地反覆進行複製和粘貼操作。在本節中，我們將介紹兩種簡單的方法來高效完成此任務，為您節省時間並減少出錯的可能性。

使用 VBA 程式碼根據列值將數據分割到多個工作表中

1. 按住 ALT + F11 鍵以打開 Microsoft Visual Basic for Applications 視窗。

2. 點擊 插入 > 模組，然後在模組視窗中粘貼以下程式碼。

Sub Splitdatabycol()
'updateby Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3. 接著，按下 F5 鍵運行程式碼，隨後會彈出一個提示框提醒您選擇標題行，然後點擊 確定。請參見截圖：

4. 在第二個提示框中，請選擇您要基於分割的列數據，然後點擊 確定。請參見截圖：

5. 當前工作表中的所有數據都根據列值被分割到多個工作表中。生成的工作表根據分割儲存格中的值命名，並放置在工作簿的末尾。請參見截圖：

使用 Kutools for Excel 根據列值將數據分割到多個工作表中

Kutools for Excel 將智能功能 - 分割數據 直接引入您的 Excel 環境。將數據分割到多個工作表不再是一個挑戰。我們直觀的工具會自動根據所選列值或行數分割數據集，確保每條信息都準確位於您需要的地方。告別手動整理電子表格的繁瑣任務，擁抱更快、無錯誤的數據管理方式。

安裝 Kutools for Excel 後，選擇數據區域，然後點擊 Kutools Plus > 分割數據 以打開 分割數據至多個工作表 對話框。

1. 在 分割依據 區域選擇 指定列 選項，並從下拉列表中選擇您希望基於分割數據的列值。
2. 如果您的數據包含標題並且您希望將它們插入到每個新的分割工作表中，請勾選 數據包含標題 選項。（您可以根據數據指定標題行的數量。例如，如果您的數據包含兩個標題，請輸入 2。）
3. 然後，您可以指定分割工作表的名稱，在 新工作表名 區域，從 規則 下拉列表中指定工作表名規則，您還可以為工作表名添加 前綴 或 後綴。
4. 點擊 確定 按鈕。請參見截圖：
   

現在，工作表中的數據已分割到新工作簿中的多個工作表中。

使用 VBA 程式碼根據列值將數據分割到多個工作簿中

有時候，與其將數據分割到多個工作表中，不如將數據分割到單獨的工作簿中更有益，特別是基於關鍵列的情況。以下是使用 VBA 程式碼自動化根據特定列值將數據分割到多個工作簿中的逐步指南。

1. 按住 ALT + F11 鍵以打開 Microsoft Visual Basic for Applications 視窗。

2. 點擊 插入 > 模組，然後在模組視窗中粘貼以下程式碼。

Sub SplitDataByColToWorkbooks()
    ' Updateby Extendoffice
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim xTRg As Range
    Dim xVRg As Range
    Dim xWS As Workbook
    Dim savePath As String
    ' Set the directory to save new workbooks
    savePath = "C:\Users\AddinsVM001\Desktop\multiple files\" ' Modify this path as needed
    Application.DisplayAlerts = False
    Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", Type:=8)
    If TypeName(xTRg) = "Nothing" Then Exit Sub
    Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", Type:=8)
    If TypeName(xVRg) = "Nothing" Then Exit Sub
    vcol = xVRg.Column
    Set ws = xTRg.Worksheet
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = xTRg.Address(False, False)
    titlerow = xTRg.Row
    ws.Columns(vcol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, ws.Columns.Count), Unique:=True
    myarr = Application.Transpose(ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).Value)
    ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).ClearContents
    For i = 2 To UBound(myarr)
        Set xWS = Workbooks.Add
        ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i)
        ws.Range("A" & titlerow & ":A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        xWS.Sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteAll
        xWS.SaveAs Filename:=savePath & myarr(i) & ".xlsx"

        xWS.Close SaveChanges:=False
    Next i
    ws.AutoFilterMode = False
    Application.DisplayAlerts = True
    ws.Activate
End Sub

3. 接著，按下 F5 鍵運行程式碼，隨後會彈出一個提示框提醒您選擇標題行，然後點擊 確定。請參見截圖：

4. 在第二個提示框中，請選擇您要基於分割的列數據，然後點擊 確定。請參見截圖：

5. 分割完成後，當前工作表中的所有數據都根據列值被分割到多個工作簿中。所有分割的工作簿都被保存到您指定的文件夾中。請參見截圖：

相關文章：