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. 分割完成后，当前工作表中的所有数据都根据列值被分割到多个工作簿中。所有分割后的工作簿都被保存到您指定的文件夹中。请参见截图：

相关文章：