Excel多工作表数据自动汇总需求：指定日期归集并按供应商排序

核心思路 #

1. 自动获取前一日日期（支持手动指定）
2. 遍历5个目标工作表，筛选出对应日期的行数据
3. 将收集到的所有数据按Suplier列排序
4. 清空summary工作表原有内容，写入排序后的数据

VBA代码实现 #

Sub GenerateDailyPurchaseReport()
    Dim ws As Worksheet
    Dim summaryWs As Worksheet
    Dim targetDate As Date
    Dim dataArr() As Variant
    Dim rowCount As Long
    Dim i As Long, j As Long, k As Long
    Dim tempArr As Variant
    
    ' 设置目标日期：默认取前一日，可替换为指定日期如 #12/04/2024#
    targetDate = DateAdd("d", -1, Date)
    
    ' 定位或新建summary工作表
    On Error Resume Next
    Set summaryWs = ThisWorkbook.Worksheets("summary")
    On Error GoTo 0
    If summaryWs Is Nothing Then
        Set summaryWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        summaryWs.Name = "summary"
    End If
    
    ' 清空summary原有数据（保留表头）
    summaryWs.Cells.Clear
    summaryWs.Range("A1:D1") = Array("Date", "Suplier", "Object", "price")
    
    rowCount = 0
    ' 遍历目标工作表（自动跳过summary）
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "summary" Then
            ' 遍历当前表数据行（表头在第1行）
            For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                ' 匹配目标日期
                If IsDate(ws.Cells(i, "A").Value) And ws.Cells(i, "A").Value = targetDate Then
                    rowCount = rowCount + 1
                    ReDim Preserve dataArr(1 To 4, 1 To rowCount)
                    dataArr(1, rowCount) = ws.Cells(i, "A").Value
                    dataArr(2, rowCount) = ws.Cells(i, "B").Value
                    dataArr(3, rowCount) = ws.Cells(i, "C").Value
                    dataArr(4, rowCount) = ws.Cells(i, "D").Value
                End If
            Next i
        End If
    Next ws
    
    ' 按供应商名称排序（不区分大小写）
    For i = 1 To rowCount - 1
        For j = i + 1 To rowCount
            If UCase(dataArr(2, i)) > UCase(dataArr(2, j)) Then
                For k = 1 To 4
                    tempArr = dataArr(k, i)
                    dataArr(k, i) = dataArr(k, j)
                    dataArr(k, j) = tempArr
                Next k
            End If
        Next j
    Next i
    
    ' 写入数据到summary
    If rowCount > 0 Then
        summaryWs.Range("A2").Resize(rowCount, 4) = Application.Transpose(dataArr)
    End If
    
    ' 自动调整列宽
    summaryWs.Columns("A:D").AutoFit
    
    MsgBox "采购报告已生成，共" & rowCount & "条数据", vbInformation
End Sub

代码说明 #

• 日期自定义：若不需要自动取前一日，可将targetDate行改为targetDate = #MM/DD/YYYY#格式手动指定日期
• 工作表适配：如果5个目标工作表有固定名称，可将遍历逻辑改为For Each ws In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
• 排序逻辑：使用冒泡排序实现供应商名称不区分大小写排序，保证结果稳定
• 容错处理：自动检测summary表是否存在，不存在则自动新建

使用步骤 #

1. 打开目标Excel文件，按下Alt + F11打开VBA编辑器
2. 右键点击工作簿名称 → 插入 → 模块，粘贴上述代码
3. 按下F5运行代码，或通过Excel「开发工具」→「宏」选择GenerateDailyPurchaseReport执行

内容的提问来源于stack exchange，提问作者Vlad Rares