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

15968725770

物料编码对应相减并汇总

最佳答案

月排行榜 / 总排行榜

哥儿-

2022-11-24 20:43

和之前发的没多大变化，代码改改就能用了
Sub test()
    Dim vArr, brr, crr, dic As Object, i%, j%
    vArr = 工作表2.Range("A2").CurrentRegion.Resize(, 17)
    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) - vArr(j, 16))
            crr(dic(vArr(j, 1)), 2) = crr(dic(vArr(j, 1)), 2) + (vArr(j, 14) - vArr(j, 17))
        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(, 17)
    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) - vArr(j, 16))
            crr(dic(vArr(j, 1)), 2) = crr(dic(vArr(j, 1)), 2) + (vArr(j, 14) - vArr(j, 17))
        End If
    Next j
    工作表1.Range("K3").Resize(UBound(crr), 2).ClearContents
    工作表1.Range("K3").Resize(UBound(crr), 2) = crr
End Sub