求大神写个VBA把数据汇总到模板总表中

15698929610

求大神把数据列表中的数据分类汇总到模板总表中，多谢啊

liangmutou01

何是数据列表？何是汇总表？以何分类？既要求助，就应该把需求说清楚。

liulang0808

http://club.excelhome.net/thread-1385473-1-1.html
这个字典实例，楼主可以参考下的

15698929610

liangmutou01 发表于 2019-2-17 14:59
何是数据列表？何是汇总表？以何分类？既要求助，就应该把需求说清楚。

有2个EXCL工作簿嘛   一个是数据    需要把这个数据里面的信息  汇总到模板总表里面，

james.wan

就楼主所发的示例，用数据透视表不可以达到要求吗？

15698929610

james.wan 发表于 2019-2-17 17:21
就楼主所发的示例，用数据透视表不可以达到要求吗？

不会透视表、汗

乐乐2006201505

将“模板总表”中统计表格放到本文件第二个工作表的位置即可。
Sub Macro1数据汇总求和()
    Dim arr, brr, crr, d1, d2, i&
    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    Set d3 = CreateObject("scripting.dictionary")
    arr = Sheets(1).Range("a1").CurrentRegion
    With Sheets(2)
        .Range("c3:l9").ClearContents
        .Range("c14:l18").ClearContents
        brr = .Range("a1:l9")
        crr = .Range("a12:l18")
    End With
    For i = 2 To UBound(arr)
        s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 4)
        d1(s) = d1(s)  + arr(i, 3)
    Next
    t = d1.items
    For i1 = 2 To UBound(brr) - 1
        For j = 3 To UBound(brr, 2)
            s1 = brr(1, 1) & "|" & brr(i1 + 1, 1) & "|" & brr(2, j)
            If d1.exists(s1) Then
                n = n + 1
                Sheets(2).Cells(i1 + 1, j) = t(n - 1)
            End If
        Next
    Next
    m = n
    For i2 = 2 To UBound(crr) - 1
        For j1 = 3 To UBound(crr, 2)
            s2 = crr(1, 1) & "|" & crr(i2 + 1, 1) & "|" & crr(2, j1)
            If d1.exists(s2) Then
                m = m + 1
                Sheets(2).Cells(i2 + 12, j1) = t(m - 1)
            End If
        Next
    Next
End Sub

乐乐2006201505

这个代码不用复制，直接可以使用。
Sub Macro1数据汇总求和()
    Dim arr, brr, crr, d1, d2, i&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    Set d3 = CreateObject("scripting.dictionary")
    arr = ThisWorkbook.Sheets(1).Range("a1").CurrentRegion
    fp = ThisWorkbook.Path & "\模板总表.xlsx"
    Set wb = GetObject(fp) 'Workbooks.Open
    With wb.Sheets(1)
        .Range("c3:l9").ClearContents
        .Range("c14:l18").ClearContents
        brr = .Range("a1:l9")
        crr = .Range("a12:l18")
    End With
    For i = 2 To UBound(arr)
        s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 4)
        d1(s) = d1(s) + arr(i, 3)
    Next
    t = d1.items
    With wb
        With .Sheets(1)
            For i1 = 2 To UBound(brr) - 1
                For j = 3 To UBound(brr, 2)
                    s1 = brr(1, 1) & "|" & brr(i1 + 1, 1) & "|" & brr(2, j)
                    If d1.exists(s1) Then
                        n = n + 1
                        .Cells(i1 + 1, j) = t(n - 1)
                    End If
                Next
            Next
            m = n
            For i2 = 2 To UBound(crr) - 1
                For j1 = 3 To UBound(crr, 2)
                    s2 = crr(1, 1) & "|" & crr(i2 + 1, 1) & "|" & crr(2, j1)
                    If d1.exists(s2) Then
                        m = m + 1
                        .Cells(i2 + 12, j1) = t(m - 1)
                    End If
                Next
            Next
        End With
        .Windows(1).Visible = True
        .Close 1
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

15698929610

乐乐2006201505 发表于 2019-2-17 20:23
这个代码不用复制，直接可以使用。
Sub Macro1数据汇总求和()
    Dim arr, brr, crr, d1, d2, i&

多谢。我先研究下啊。

jjmysjg

乐乐2006201505 发表于 2019-2-17 20:03
将“模板总表”中统计表格放到本文件第二个工作表的位置即可。
Sub Macro1数据汇总求和()
    Dim arr, b ...

留下记号，谢谢