恳请高手师傅们帮忙看下这个合并计算的难题

qiongmei6

在附件内我希望得到一个代码，就是把b列同一个名称的数相加，显示在b：d列，例如现在g：i列就是我希望得到的结果，但是我希望这个结果是直接显示b：d列，谢谢高手师傅的帮忙

ykcbf1100

这个用字典最简单。

gwjkkkkk

参与一下。。。

准提部林

        For i = 1 To UBound(arr)
            s$ = arr(i, 2): T = d(s)
            If Not IsArray(T) Then T = Array(s, arr(i, 3), 0)
            T(2) = T(2) + arr(i, 4)
            d(s) = T
        Next i

lushang2018

1. Sub 测试()  ''答题专用套路--by:学习使我快乐
   
2.     Dim i, j, k, m, n, arr, brr, crr, drr
   
3.     Dim sht As Worksheet, wbk As Workbook, rng As Range
   
4.     Dim dic As Object, key As String, keys, items
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     arr = Sheet1.Range("A1").CurrentRegion
   
7.     ReDim brr(1 To 3)
   
8.     For i = 4 To UBound(arr)
   
9.         key = arr(i, 2)
   
10.         If Not dic.Exists(key) Then
    
11.             k = k + 1
    
12.             For j = 1 To 3
    
13.                 brr(j) = arr(i, j + 1)
    
14.             Next
    
15.             dic(key) = brr
    
16.         Else
    
17.             brr = dic(key)
    
18.             brr(3) = brr(3) + arr(i, 4)
    
19.             dic(key) = brr
    
20.         End If
    
21.     Next
    
22.     keys = dic.keys
    
23.     For i = LBound(keys) To UBound(keys)
    
24.         key = keys(i)
    
25.         Sheet1.Cells(4 + i, "G").Resize(1, 3) = dic.items()(i)
    
26.     Next
    
27. End Sub
    

复制代码