Let's break down how to solve this problem efficiently. The core idea is to use a dictionary to track each department's hours across all months, then dump that aggregated data into your target summary sheet. Here's a complete, commented solution tailored to your needs:

Step 1: Prep Your Workbook First #

• Confirm your 12 monthly sheets are named exactly 1月, 2月, ..., 12月
• Create a target summary sheet (we’ll use 工时汇总 in the code—adjust the name if you prefer something else)
• Assume each monthly sheet has:
  • Column A: Department Name (部门名称)
  • Column B: Allocated Hours (分配工时)
    (Tweak column references in the code if your sheet structure differs)

Step 2: VBA Code Implementation #

Open the VBA editor (press Alt + F11), insert a new module, and paste this code:

Sub AggregateDepartmentHours()
    Dim ws As Worksheet
    Dim summaryWs As Worksheet
    Dim deptDict As Object
    Dim deptName As String
    Dim hours As Double
    Dim monthNum As Integer
    Dim lastRow As Long
    Dim i As Long
    Dim summaryRow As Long
    Dim monthCols As Variant
    
    ' Initialize dictionary to store department data (auto-handles unique departments)
    Set deptDict = CreateObject("Scripting.Dictionary")
    deptDict.CompareMode = vbTextCompare ' Ignore case/spacing differences for department names
    
    ' Locate or validate the summary sheet
    On Error Resume Next
    Set summaryWs = ThisWorkbook.Sheets("工时汇总")
    On Error GoTo 0
    If summaryWs Is Nothing Then
        MsgBox "请先创建名为'工时汇总'的工作表！", vbExclamation
        Exit Sub
    End If
    
    ' Clear old data in summary sheet to avoid duplicates
    summaryWs.Cells.Clear
    
    ' Set up header row: Department + 12 months + Annual Total
    summaryWs.Range("A1").Value = "部门名称"
    monthCols = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
    For monthNum = 1 To 12
        summaryWs.Range(monthCols(monthNum - 1) & "1").Value = monthNum & "月"
    Next monthNum
    summaryWs.Range("N1").Value = "年度总计"
    
    ' Loop through each monthly sheet
    For monthNum = 1 To 12
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(monthNum & "月")
        On Error GoTo 0
        If ws Is Nothing Then
            MsgBox "缺少" & monthNum & "月工作表！", vbExclamation
            Continue For
        End If
        
        ' Find the last row with data in the current monthly sheet
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ' Iterate through each row of department data
        For i = 2 To lastRow ' Start at row 2 assuming row 1 is a header
            deptName = Trim(ws.Cells(i, "A").Value)
            hours = ws.Cells(i, "B").Value
            
            If deptName <> "" Then
                ' Add new department to dictionary if it doesn't exist
                If Not deptDict.Exists(deptName) Then
                    deptDict(deptName) = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) ' 12 months + annual total
                End If
                
                ' Update monthly hours for the department
                deptDict(deptName)(monthNum - 1) = deptDict(deptName)(monthNum - 1) + hours
                ' Update running annual total
                deptDict(deptName)(12) = deptDict(deptName)(12) + hours
            End If
        Next i
    Next monthNum
    
    ' Write all aggregated data to the summary sheet
    summaryRow = 2 ' Start writing from row 2 (after header)
    For Each deptName In deptDict.Keys
        summaryWs.Cells(summaryRow, "A").Value = deptName
        ' Populate monthly hours
        For monthNum = 1 To 12
            summaryWs.Cells(summaryRow, monthNum + 1).Value = deptDict(deptName)(monthNum - 1)
        Next monthNum
        ' Populate annual total
        summaryWs.Cells(summaryRow, "N").Value = deptDict(deptName)(12)
        summaryRow = summaryRow + 1
    Next deptName
    
    ' Optional: Format the summary sheet for readability
    summaryWs.Range("A1:N" & summaryRow - 1).AutoFilter
    summaryWs.Range("A1:N1").Font.Bold = True
    summaryWs.Columns("A:N").AutoFit
    
    MsgBox "工时汇总完成！", vbInformation
End Sub

Key Benefits of This Code #

• Handles sparse departments: Departments that only appear in some months will show up in the summary with 0 for missing months
• Robust matching: Ignores case and extra spaces in department names to avoid duplicate entries
• Error checking: Alerts you if any monthly sheet or the summary sheet is missing
• Clean output: Adds filters, bold headers, and auto-fits columns to make the summary easy to read

Quick Usage Tips #

1. Adjust column references (e.g., if your hours are in column C instead of B, change ws.Cells(i, "B") to ws.Cells(i, "C"))
2. Modify the summary sheet name in the code if you aren't using 工时汇总
3. Run the macro (press F5 in the VBA editor, or assign it to a button in Excel for one-click access)

内容的提问来源于stack exchange，提问作者Gopala Krishna