合并同类项

洋务德雷

这个透视表不就搞定了吗？

chxw68

用SQL也行。

zyr2046

1. Sub 套路()   '//答题专用套路-By瘾大技术差
   
2.     Dim i, j, k, arr, brr, crr, Rng As Range, Sht As Worksheet
   
3.     Dim d As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     arr = Sheet1.Range("a2:c" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
   
6.     ReDim brr(1 To UBound(arr), 1 To 3)
   
7.     For i = 1 To UBound(arr)
   
8.         Key = arr(i, 1) & "@@" & arr(i, 2)
   
9.         If Not d.exists(Key) Then
   
10.             k = k + 1
    
11.             d(Key) = k
    
12.             brr(k, 1) = arr(i, 1)
    
13.             brr(k, 2) = arr(i, 2)
    
14.             brr(k, 3) = arr(i, 3)
    
15.         Else
    
16.             m = d(Key)
    
17.             brr(m, 3) = brr(m, 3) + arr(i, 3)
    
18.         End If
    
19.     Next
    
20.     Sheet2.Range("a2:c60000").ClearContents
    
21.     Sheet2.Range("a2").Resize(k, 3) = brr
    
22. End Sub
    
23. 
    

复制代码

liaolulu333

liulang0808 发表于 2023-4-24 07:17
Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion

感谢，相当给力！

liaolulu333

liulang0808 发表于 2023-4-24 07:18
https://club.excelhome.net/thread-1385473-1-1.html?_dsign=b73ad3d6

感谢分享！！

liaolulu333

chxw68 发表于 2023-4-24 08:54

感谢帮助，相当给力