Excel VBA 按部门拆分每月数据并创建工作表

以下是按部门拆分每月 SHEET 并命名的 VBA 代码：

Sub SplitByDepartmentAndMonth()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim department As String, month As String
    Dim newSheetName As String
    
    ' 获取当前活动的工作表
    Set ws = ActiveSheet
    
    ' 获取数据的最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 循环遍历数据行
    For i = 2 To lastRow
        ' 获取部门和月份
        department = ws.Cells(i, "B").Value
        month = Format(ws.Cells(i, "A").Value, "mmmm")
        
        ' 创建新的 SHEET 名称
        newSheetName = department & "-" & month
        
        ' 检查是否已存在同名的 SHEET，如果不存在则创建新的 SHEET
        On Error Resume Next
        Set ws = Worksheets(newSheetName)
        On Error GoTo 0
        If ws Is Nothing Then
            Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            ws.Name = newSheetName
        End If
        
        ' 将当前行的数据复制到新的 SHEET 中
        ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = _
            ws.Cells(i, "A").Resize(, 3).Value
    Next i
    
    ' 移除原始工作表
    Application.DisplayAlerts = False
    Sheets(1).Delete
    Application.DisplayAlerts = True
End Sub

使用方法：

1. 打开 Excel 并打开要处理的汇总表。
2. 按下 ALT+F11 打开 VBA 编辑器。
3. 在左侧的项目窗口中，双击要处理的汇总表。
4. 在右侧的代码窗口中，粘贴上述代码。
5. 按下 F5 运行代码。

代码将按部门拆分每月的 SHEET，并命名为“部门-月份”。原始的汇总表会被删除，只保留拆分后的 SHEET。