[已解决]物料编码对应汇总

15968725770

物料编码对应汇总

最佳答案

月排行榜 / 总排行榜

哥儿-

2022-11-21 21:24

这边打开工作表名称是中文的，如果不一样，代码自己改改
Sub test()
    Dim vArr, brr, crr, dic As Object, i%, j%
    vArr = 工作表2.Range("A2").CurrentRegion.Resize(, 15)
    brr = 工作表1.Range("A2").CurrentRegion
    ReDim crr(1 To UBound(brr) - 1, 1 To 2)
    Set dic = VBA.CreateObject("scripting.dictionary")
    For i = 2 To UBound(brr)
        dic(brr(i, 1)) = i - 1
    Next i
    For j = 2 To UBound(vArr)
        If dic.exists(vArr(j, 1)) Then
            crr(dic(vArr(j, 1)), 1) = crr(dic(vArr(j, 1)), 1) + vArr(j, 13)
            crr(dic(vArr(j, 1)), 2) = crr(dic(vArr(j, 1)), 2) + vArr(j, 15)
        End If
    Next j
    工作表1.Range("K3").Resize(UBound(crr), 2).ClearContents
    工作表1.Range("K3").Resize(UBound(crr), 2) = crr
End Sub

跳转到最佳答案楼层

哥儿-

这边打开工作表名称是中文的，如果不一样，代码自己改改
Sub test()
    Dim vArr, brr, crr, dic As Object, i%, j%
    vArr = 工作表2.Range("A2").CurrentRegion.Resize(, 15)
    brr = 工作表1.Range("A2").CurrentRegion
    ReDim crr(1 To UBound(brr) - 1, 1 To 2)
    Set dic = VBA.CreateObject("scripting.dictionary")
    For i = 2 To UBound(brr)
        dic(brr(i, 1)) = i - 1
    Next i
    For j = 2 To UBound(vArr)
        If dic.exists(vArr(j, 1)) Then
            crr(dic(vArr(j, 1)), 1) = crr(dic(vArr(j, 1)), 1) + vArr(j, 13)
            crr(dic(vArr(j, 1)), 2) = crr(dic(vArr(j, 1)), 2) + vArr(j, 15)
        End If
    Next j
    工作表1.Range("K3").Resize(UBound(crr), 2).ClearContents
    工作表1.Range("K3").Resize(UBound(crr), 2) = crr
End Sub

风林火山

=SUMIF(Sheet2!$A$3:$A$10,$A3,Sheet2!$M$3:$M$10)
=SUMIF(Sheet2!$A$3:$A$10,$A3,Sheet2!$O$3:$O$10)

15968725770

风林火山 发表于 2022-11-22 08:27
=SUMIF(Sheet2!$A$3:$A$10,$A3,Sheet2!$M$3:$M$10)
=SUMIF(Sheet2!$A$3:$A$10,$A3,Sheet2!$O$3:$O$10)

VBA编写，谢谢

风林火山

1. Sub test()
   
2.     Dim arr, brr(), k As Integer, d1, d2
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     Set d2 = CreateObject("scripting.dictionary")
   
5.     Sheets("sheet2").Select
   
6.     arr = Range("a3:o" & Cells(Rows.Count, 1).End(3).Row)
   
7.     For k = 1 To UBound(arr)
   
8.         d1(arr(k, 1)) = d1(arr(k, 1)) + arr(k, 13)
   
9.         d2(arr(k, 1)) = d2(arr(k, 1)) + arr(k, 15)
   
10.     Next k
    
11.     Sheets("sheet1").Select
    
12.     For k = 3 To Cells(Rows.Count, 1).End(3).Row
    
13.         Cells(k, 11) = d1(Cells(k, 1).Value)
    
14.         Cells(k, 12) = d2(Cells(k, 1).Value)
    
15.     Next
    
16. End Sub
    

复制代码