求助多行的数据汇总

Qs18

试试...........

Qs18

试试...........

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, j&, r&, dic As Object
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = Worksheets(2).[C1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        dic(ar(i, 1)) = dic(ar(i, 1)) + ar(i, 2)
    Next i
   
    With [B1].CurrentRegion
        ar = .Value
        For i = 2 To UBound(ar)
            ar(i, 2) = dic(ar(i, 1))
        Next i
        .Value = ar
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

............

sunyuanzhang

Qs18 发表于 2024-9-5 18:05

不好意思！
如果汇总表里我把入库数挪到K列，k列与B列之间有数据
程序怎么修改啊！我没改明白
请赐教

Qs18

sunyuanzhang 发表于 2024-9-6 12:30
不好意思！
如果汇总表里我把入库数挪到K列，k列与B列之间有数据
程序怎么修改啊！我没改明白

根据实际情况改就是

sunyuanzhang

Qs18 发表于 2024-9-6 13:39
根据实际情况改就是

不知道改哪

Qs18

sunyuanzhang 发表于 2024-9-6 13:46
不知道改哪

把附件发来看看

sunyuanzhang

就是把入库数挪到了K列   K与B之间是有数据的，不能覆盖。

Qs18

1. Sub qs()
   
2. Dim arr, brr, i, dic, s
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. With Sheet2
   
5. r2 = .Cells(Rows.Count, 4).End(3).Row
   
6.     arr = .Range("d1").Resize(r2, 2).Value
   
7. End With
   
8. For i = 2 To UBound(arr)
   
9.     s = arr(i, 1)
   
10.     If Not dic.exists(s) Then
    
11.         dic(s) = arr(i, 2)
    
12.     Else
    
13.         dic(s) = dic(s) + arr(i, 2)
    
14.     End If
    
15. Next
    
16. With Sheet1
    
17.     r = .Cells(Rows.Count, 2).End(xlUp).Row
    
18.     brr = .Range("b1").Resize(r, 2).Value
    
19.     For i = 2 To UBound(brr)
    
20.         If dic.exists(brr(i, 1)) Then
    
21.             brr(i, 2) = dic(brr(i, 1))
    
22.         End If
    
23.     Next
    
24.     .Range("k1").Resize(10000, 1).ClearContents
    
25.     brr(1, 2) = "入库数"
    
26.     .Range("k1").Resize(UBound(brr), 1) = Application.Index(brr, 0, 2)
    
27. End With
    
28. End Sub
    

复制代码