分类汇总的求助

thb5331232

附件中有说明，求修改代码，谢谢了先！

zjdh

工作簿188.rar (20.54 KB, 下载次数: 4)

2023-2-15 10:21 上传

点击文件名下载附件

thb5331232

zjdh 发表于 2023-2-15 10:21

谢谢，但是汇总的数量是错的。请帮忙再看下！

thb5331232

zjdh 发表于 2023-2-15 10:21

搞定了！如果把2列条件互换一下怎样改？我改了很久没成功，能否帮忙看下，谢谢了先！

zjdh

是这样吗？
工作簿188-.rar (20.56 KB, 下载次数: 14)

2023-2-15 22:50 上传

点击文件名下载附件

thb5331232

zjdh 发表于 2023-2-15 22:50
是这样吗？

谢谢您，解决了

thb5331232

zjdh 发表于 2023-2-15 10:21

老师，如果在数据最后一行的单元格进行汇总的代码怎样改？谢谢了先

dou10801

zjdh大大範本
Dim arr, dic, i%
    Set dic = CreateObject("scripting.dictionary")
    Set dic1 = CreateObject("scripting.dictionary")
    s = 0
    p = 0
    With ActiveSheet
        arr = Sheets("表").Range("P2:X" & Sheets("表").Range("X65535").End(xlUp).Row)
        For i = 1 To UBound(arr)
            If dic.exists(arr(i, 9)) Then
                dic(arr(i, 9)) = dic(arr(i, 9)) + 1
                'dic1(arr(i, 1)) = dic1(arr(i, 9)) + arr(i, 1)
                dic1(arr(i, 9)) = dic1(arr(i, 9)) + arr(i, 1)
            Else
                dic(arr(i, 9)) = 1
                dic1(arr(i, 9)) = arr(i, 1)
            End If
            s = s + arr(i, 1)
            p = p + 1
        Next
        Sheets("匯總表").Range("C2:E5000").ClearContents
        Sheets("匯總表").[C2].Resize(dic.Count, 1) = Application.Transpose(dic.Keys)
        Sheets("匯總表").[D2].Resize(dic.Count, 1) = Application.Transpose(dic.Items)
        Sheets("匯總表").[E2].Resize(dic.Count, 1) = Application.Transpose(dic1.Items)
        Sheets("匯總表").Range("d" & dic.Count + 2) = p
        Sheets("匯總表").Range("e" & dic.Count + 2) = s
     End With

chen301222

只要一个字典也可以
Sub 汇总2()
  Dim r%, i%
  Dim arr, brr
  Dim d As Object
  Set d = CreateObject("scripting.dictionary")
  With Worksheets("表")
    r = .Cells(.Rows.Count, "p").End(xlUp).Row
    arr = .Range("p2:x" & r)
  End With
  For i = 1 To UBound(arr)
    xm = arr(i, 1)
    If Not d.exists(xm) Then
      ReDim brr(1 To 3)
      brr(1) = xm
    Else
      brr = d(xm)
    End If
    brr(2) = brr(2) + 1
    brr(3) = brr(3) + arr(i, 9)
    d(xm) = brr
  Next
  With Worksheets("汇总表")
    .Range("c2").Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
  End With
End Sub

kszcs

zjdh 发表于 2023-2-15 22:50
是这样吗？

留下记号，谢谢大师