帮忙看下代码，执行后出错

ruhong18

Sub 宏1()
    Dim arr, brr(1 To 100000, 1 To 8), i&, j&, m&, t, d As Object, sh As Worksheet
    Set d = CreateObject("scripting.dictionary")
    For Each sh In Worksheets
        If sh.Name <> "汇总" Then
            arr = sh.[a1].CurrentRegion
            For i = 3 To UBound(arr)
                t = d(arr(i, 3))
                If t = "" Then
                    m = m + 1
                    d(arr(i, 3)) = m
                    For j = 3 To 8
                        brr(m, j) = arr(i, j)
                    Next
                Else
                    For j = 4 To 8
                        brr(t, j) = brr(t, j) + arr(i, j)
                    Next
                End If
            Next
        End If
    Next
    ActiveSheet.UsedRange.Offset(2).ClearContents
    Range("c3").Resize(m, 8) = brr
End Sub
另外，如何再该代码的汇总页，内容尾行添加合计？（增加语句）

爱疯

Sub test()
    Dim A, i, n


    Application.DisplayAlerts = False
    n = Sheets.Count
    On Error Resume Next
    Sheets(n).Delete
    On Error GoTo 0
    n = n - 1
    Sheets.Add(after:=Sheets(n)).Name = "汇总"


    ReDim A(1 To n)
    For i = LBound(A) To UBound(A)
        With Sheets(i)
            A(i) = .Name & "!" & .[c2:g6].Address(, , xlR1C1)
        End With
    Next
    ActiveSheet.PivotTableWizard xlConsolidation, A, [a1]

End Sub




这样可以吗

hfwufanhf2006

试下这个：

    Dim arr, brr(1 To 100000, 1 To 8), i&, j&, m&, t, d As Object, sh As Worksheet
    Set d = CreateObject("scripting.dictionary")

    For Each sh In Worksheets
        If sh.Name <> "汇总" Then
            arr = sh.[c2].CurrentRegion
            For i = 3 To UBound(arr)
                t = arr(i, 1)
                If Not d.exists(t) Then
                    m = m + 1
                    d(t) = m
                    For j = 1 To 5
                        brr(m, j) = arr(i, j)
                    Next j
                Else
                    For j = 2 To 5
                        brr(d(t), j) = brr(d(t), j) + arr(i, j)
                    Next
                End If
            Next
        End If
    Next
    ActiveSheet.UsedRange.Offset(2).ClearContents
    Range("c3").Resize(m, 8) = brr

ruhong18

hfwufanhf2006 发表于 2019-12-26 15:42
试下这个：

    Dim arr, brr(1 To 100000, 1 To 8), i&, j&, m&, t, d As Object, sh As Worksheet

感谢老师修改，代码测试正确，如何在汇总尾行添加合计呢？

ruhong18

爱疯 发表于 2019-12-26 15:28
Sub test()
    Dim A, i, n

感谢版主，这个也可以用，数据透视表！

hfwufanhf2006

ruhong18 发表于 2019-12-26 15:54
感谢老师修改，代码测试正确，如何在汇总尾行添加合计呢？

合计很好办，一般用工作表函数sum就行了，没必要自己去统计：
第一个参数行是第3行，直接写上去即可；
第二个参数行是[c10000].end(3).row，因此完整的代码是：
cells([c10000].end(3).row+1,3)="合计"     '在c列写入文本“合计”
cells([d10000].end(3).row+1,4)="=sum(d3:d" & [d10000].end(3).row & ")"     '在d列的最末行插入函数sum

e、f、g三列的合计你按照上面的样子自己添加

与此前不同，因为有合计行，没了防止汇总重复（比如合计行无限增加），所以需要在代码的最前面加一行：
    Range("c3:g100").ClearContents

意思是汇总前先清除c3:g100的区域，为本次汇总做准备，这行要放在最前面

ruhong18

hfwufanhf2006 发表于 2019-12-26 16:31
合计很好办，一般用工作表函数sum就行了，没必要自己去统计：
第一个参数行是第3行，直接写上去即可；
...

感谢老师的指导与帮助！学习~