请教各位高手：如何汇总分表相应日期的数据

songhzh

quqiyuan 发表于 2024-11-4 16:16
像这种多个工作表，名称没有规律，还是用vba来得方便

请帮忙做一个，谢谢

quqiyuan

songhzh 发表于 2024-11-4 17:07
请帮忙做一个，谢谢

做了一下，其实就是汇总，供你参考。。。

quqiyuan

代码如下，，，
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("汇总表")
    r = sht.Cells(Rows.Count, 1).End(3).Row
    arr = sht.Range(sht.[a1], sht.Cells(r, "c"))
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If s <> Empty Then d(s) = i - 1
    Next
    ReDim crr(1 To UBound(arr) - 1, 1 To 2)
    For Each sh In wb.Sheets
        If sh.Name <> sht.Name Then
            r = sh.Cells(Rows.Count, 2).End(3).Row
            brr = sh.Range(sh.[a1], sh.Cells(r, "j"))
            If IsArray(brr) Then
                For i = 6 To UBound(brr)
                    s = brr(i, 1)
                    If d.exists(s) Then
                        crr(d(s), 1) = crr(d(s), 1) + brr(i, 4)
                        crr(d(s), 2) = crr(d(s), 2) + brr(i, 8)
                    End If
                Next
            End If
        End If
    Next
    sht.[b2].Resize(UBound(crr), 2) = crr
    Set d = Nothing
    Beep
End Sub

songhzh

quqiyuan 发表于 2024-11-4 17:38
做了一下，其实就是汇总，供你参考。。。

谢谢