Excel VBA 按部门拆分汇总表格

使用 VBA 按部门拆分 Excel 汇总表格

本文将介绍如何使用 VBA 代码将 Excel 汇总表格按部门拆分成多个独立的工作表。以下步骤提供详细的代码示例和操作说明：

打开 VBA 编辑器: 在 Excel 中，按下 Alt + F11 快捷键打开 VBA 编辑器。
插入模块: 在左侧的“项目资源管理器”窗口中，右键点击 VBAProject (你的工作簿名字)，选择“插入”->“模块”。
编写 VBA 代码: 在新插入的模块中，粘贴以下 VBA 代码：

Sub SplitByDepartment()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim rng As Range
    Dim department As String
    
    ' 设置汇总表格所在的工作表
    Set ws = ThisWorkbook.Worksheets('汇总表格')
    
    ' 获取最后一行的行号
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 循环遍历每一行数据
    For i = 2 To lastRow
        ' 获取当前行的部门名称
        department = ws.Cells(i, 2).Value
        
        ' 检查是否已经存在同名的工作表，如果不存在则创建
        On Error Resume Next
        Set newWs = Worksheets(department)
        On Error GoTo 0
        If newWs Is Nothing Then
            Set newWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            newWs.Name = department
        End If
        
        ' 复制当前行的数据到对应的工作表中
        ws.Rows(i).Copy Destination:=newWs.Cells(newWs.Cells(newWs.Rows.Count, 1).End(xlUp).Row + 1, 1)
    Next i
End Sub

修改代码: 将代码中的 '汇总表格' 替换为你的汇总表格所在的工作表名称。
执行代码: 按下 F5 键执行代码，将会按照部门名称拆分成多个工作表。

注意:

在执行代码之前，请确保你的汇总表格的第一行是标题行，部门名称在第二列（B列）。
如果某个部门的工作表已经存在，则会将数据追加到现有的工作表中。
如果要每次运行都创建新的工作表，请修改代码中的 Set newWs = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 为 Set newWs = Worksheets.Add。

希望以上内容对您有所帮助！