VBA实现一个数据提取后排序

wxw19900926

各位朋友，我遇到问题了，请帮帮忙
希望达到的目标
1.把所有的相同公司名称的单元格 AND 相同的币种单元格的  金额的值 相加。= 总的金额
生成一个新的表格，把所有公司的不同币种的费用总计做一个排序。看出哪家公司的金额最多，哪家最少。

mytto88

数据透视表就可以了

ligh1298

是这样的吗？需要手动建一个Sheet2表，放结果。

Option Explicit
Sub test()
        Dim arr, i, d, d1, d2, s, Ik, Ik2, Im
        Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
        Set sh1 = Sheets("sheet1")
        Set sh2 = Sheets("sheet2")
        sh2.Cells.Clear
        sh1.[a1:c1].Copy sh2.[a1]
         arr = sh1.[a1].CurrentRegion
         Set d = CreateObject("scripting.dictionary")
         Set d1 = CreateObject("scripting.dictionary")
         Set d2 = CreateObject("scripting.dictionary")
         
         For i = 2 To UBound(arr)
                s = arr(i, 1) & "|" & arr(i, 2)
                d(s) = arr(i, 1)
                d1(s) = arr(i, 2)
                 d2(s) = d2(s) + arr(i, 3)
         Next i
         Ik = d.items
         Ik2 = d1.items
         Im = d2.items
         sh2.[a2].Resize(d.Count) = Application.Transpose(Ik)
         sh2.[b2].Resize(d.Count) = Application.Transpose(Ik2)
         sh2.[c2].Resize(d.Count) = Application.Transpose(Im)
         sh2.Range("a1:c" & sh2.[a65536].End(3).Row).Sort sh2.[b1], 1, , sh2.[a1], 1, sh2.[c1], 1, 1
         ThisWorkbook.Save
End Sub

lvezlq

PivotTable汇总参考