【Office】【VBA宏】使用宏实现表格中根据一列分类拆分到对应的sheet表中

需求概要

实现流程

1. 由于要拆分的数据量可能会比较大考虑性能问题（关闭屏幕更新提高性能）
2. 获取当前活动的sheet表。
3. 要求选择一列作为分类拆分的依旧。
4. 要求输入数字以表示该表表头有几个行。
5. 遍历每一行，根据列的值拆分数据到对应的sheet表中。
6. 显示一个消息框来通操作已完成。

具体代码

Sub SplitDataByColumnWithHeaderRows()
    Dim originalSheet As Worksheet
    Dim newSheet As Worksheet
    Dim splitColumn As Range
    Dim headerRowsCount As Integer
    Dim lastRow As Long
    Dim cellValue As Variant
    Dim sheetExists As Boolean
    Dim i As Long
    Dim j As Long
    
    Application.ScreenUpdating = False 
    
    Application.DisplayAlerts = False
      
    Set originalSheet = ActiveSheet
      
    Set splitColumn = Application.InputBox("请选择要拆分的依据列,只能选择单列！", "选择列", Type:=8)
      
    If splitColumn.Columns.Count <> 1 Then
        MsgBox "请选择一个单一的列进行拆分", vbExclamation
        Exit Sub
    End If
      
    headerRowsCount = Application.InputBox("请输入标题行的数量", "标题行数量", Type:=1)
      
    If headerRowsCount < 1 Or Int(headerRowsCount) <> headerRowsCount Then
        MsgBox "请输入一个有效的正整数作为标题行的数量", vbExclamation
        Exit Sub
    End If
      
    lastRow = originalSheet.Cells(originalSheet.Rows.Count, splitColumn.Column).End(xlUp).Row
      
    For i = headerRowsCount + 1 To lastRow
        cellValue = splitColumn.Cells(i).Value
        sheetExists = False
          
        For Each newSheet In ThisWorkbook.Sheets
            If newSheet.Name = CStr(cellValue) Then
                sheetExists = True
                Exit For
            End If
        Next newSheet
          
        If Not sheetExists Then
            Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            newSheet.Name = CStr(cellValue)
              
            For j = 1 To headerRowsCount
                originalSheet.Rows(j).Copy Destination:=newSheet.Rows(j)
            Next j
        End If
          
        originalSheet.Rows(i).Copy Destination:=newSheet.Cells(newSheet.Cells(newSheet.Rows.Count, 1).End(xlUp).Row + 1, 1)
    Next i
      
    MsgBox "数据已按所选列拆分到不同工作表，并带有标题行", vbInformation
    
    Application.ScreenUpdating = True
    
    Application.DisplayAlerts = True
    
End Sub

使用方法

1. 打开Excel并加载包含要拆分数据的工作簿。
2. 按Alt + F11打开VBA编辑器。
3. 在项目浏览器中，右键点击你的工作簿名称，选择“插入” -> “模块”。
4. 在新打开的模块窗口中，粘贴上述代码。
5. 按F5运行SplitDataByColumnWithHeaderRows宏。
6. 根据提示框选择你要拆分的列。
7. 在下一个提示框中输入标题行的数量，例如输入2表示前两行是标题行。
8. 等待宏运行完成，数据将根据所选列的值拆分到不同的工作表中，并
9. 每个工作表都包含你指定的标题行数量。
   强调文本 强调文本

注意事项

• 在运行宏之前，请确保备份你的数据，以防万一出现意外情况。
• 请注意，上述代码假设标题行从第一行开始，并连续排列。如果你的标题行不是从第一行开始，或者中间有非标题行的间隔，你可能需要调整代码来适应你的具体需求。

小结

到此，所有分享结束了，希望代码可以帮助你们。还有更多功能和方法值得我和你们去研究，感谢浏览。有其他好的问题和经验可以在评论区留言或私信我。
提示：经测试验证数据量多时，表格程序会卡无响应一会属于正常情况，耐心等待一会即可，后续会优化拆分流程。