VBA 代码：将汇总表格按部门和月份拆分成多个工作表

本文介绍如何使用 VBA 代码将一个汇总表格（月份在第 1 列，部门在第 2 列）按照部门和月份拆分成多个工作表。

Sub SplitDataByDepartmentAndMonth()
    Dim wsSummary As Worksheet
    Dim rngData As Range
    Dim rngCell As Range
    Dim wsDepartment As Worksheet
    Dim wsNew As Worksheet
    Dim strDepartment As String
    Dim strMonth As String
    Dim lastRow As Long
    Dim i As Long
    
    ' 设置汇总表格和数据范围
    Set wsSummary = ThisWorkbook.Worksheets('汇总表格') ' 修改为你的汇总表格所在的工作表名字
    lastRow = wsSummary.Cells(wsSummary.Rows.Count, 1).End(xlUp).Row
    Set rngData = wsSummary.Range('A2:B' & lastRow) ' 假设数据从第 2 行开始，第 1 列是月份，第 2 列是部门
    
    ' 创建一个新工作表作为部门的汇总表
    Set wsDepartment = ThisWorkbook.Worksheets.Add(After:=wsSummary)
    wsDepartment.Name = '部门汇总'
    
    ' 遍历数据范围
    For Each rngCell In rngData
        strDepartment = rngCell.Offset(0, 1).Value ' 获取部门名称
        strMonth = rngCell.Value ' 获取月份
        
        ' 检查部门工作表是否已存在，如果不存在则创建新工作表
        On Error Resume Next
        Set wsNew = ThisWorkbook.Worksheets(strDepartment)
        On Error GoTo 0
        If wsNew Is Nothing Then
            Set wsNew = ThisWorkbook.Worksheets.Add(After:=wsSummary)
            wsNew.Name = strDepartment
        End If
        
        ' 将数据复制到相应的工作表
        wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value = rngCell.Resize(1, 2).Value
        wsDepartment.Cells(wsDepartment.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value = rngCell.Resize(1, 2).Value
    Next rngCell
    
    ' 删除原始汇总表格
    wsSummary.Delete
End Sub

使用说明：

将代码复制到 Excel VBA 编辑器中。
将代码中的 Set wsSummary = ThisWorkbook.Worksheets('汇总表格') 中的 '汇总表格' 修改为你的汇总表格所在的工作表名字。
运行代码。

代码功能：

创建一个新的工作表，命名为 '部门汇总'，用于汇总每个部门的数据。
遍历汇总表格中的所有数据行。
对于每一行数据，提取部门名称和月份。
检查是否存在对应部门的工作表，如果不存在则创建一个新工作表，命名为部门名称。
将当前数据行复制到相应的部门工作表和 '部门汇总' 工作表中。
删除原始汇总表格。

注意：

代码假设数据从第 2 行开始，第 1 列是月份，第 2 列是部门。
你可以根据实际情况修改代码中的数据范围、列数和工作表名称。
运行代码前请备份你的工作簿，以防意外数据丢失。