请老师帮忙根据需求汇总数据

cdg168pro

老师好：求助从前面多个工作簿汇总数据到最后一个名称为"汇总数据"的工作簿

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar, br, i&, j&, r&, dic As Object, wks As Worksheet, vItem
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    With [A5].CurrentRegion
       .Offset(1).Clear
       ar = .Resize(10 ^ 3)
       r = 1
    End With
    For i = 1 To UBound(ar, 2): dic(ar(1, i)) = i: Next
   
    For Each wks In Sheets
       If wks.Name <> "汇总数据" Then
          With wks
             br = .[A3].CurrentRegion
             For i = 2 To UBound(br)
                r = r + 1
                For j = 1 To UBound(br, 2)
                   vItem = dic(br(1, j))
                   If vItem <> "" Then
                      ar(r, vItem) = br(i, j)
                   End If
                Next j
             Next i
          End With
       End If
    Next
   
    Columns(2).NumberFormatLocal = "yyyy-m-d"
    [A5].Resize(r, UBound(ar, 2)) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请楼主参考。。。

cdg168pro

gwjkkkkk 发表于 2023-2-9 19:52
请楼主参考。。。

老师，你好。"汇总数据“工作簿里的日期没有重新排序，序号也没有重新生成

gwjkkkkk

改一下，请参考。。。

cdg168pro

gwjkkkkk 发表于 2023-2-9 20:49
改一下，请参考。。。

非常感谢！！

cdg168pro

已经改好。。。。。。。。。。。。