- Sub Macro1()
- Dim arr, ar, brr, crr, d, d2, i&, n&
- Set d = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- Sheet1.Activate
- arr = Sheet2.UsedRange
- brr = Sheet3.UsedRange
- crr = Sheet4.UsedRange
- ReDim ar(1 To UBound(arr), 1 To 5)
- w = Array("呆滞及不良品仓", "售后配件仓", "售后报废仓", "退料仓", "报废仓", "售后不良品仓")
- For i = 0 To UBound(w)
- d(w(i)) = ""
- Next
- For i = 3 To UBound(arr)
- If Not d.exists(arr(i, 2)) Then
- If Not d2.exists(arr(i, 3)) Then
- s = s + 1
- d2(arr(i, 3)) = s
- ar(s, 1) = arr(i, 4)
- ar(s, 2) = arr(i, 5)
- ar(s, 3) = arr(i, 12)
- Else
- n = d2(arr(i, 3))
- ar(n, 3) = ar(n, 3) + arr(i, 12)
- End If
- End If
- Next
- For i = 3 To UBound(brr)
- If d2.exists(brr(i, 15)) Then
- n = d2(brr(i, 15))
- ar(n, 4) = ar(n, 4) + brr(i, 8)
- End If
- Next
- For i = 2 To UBound(crr)
- If d2.exists(crr(i, 7)) Then
- n = d2(crr(i, 7))
- ar(n, 5) = ar(n, 5) + crr(i, 23) - crr(i, 30)
- End If
- Next
- For i = 2 To Range("b65536").End(xlUp).Row
- If d2.exists(Cells(i, 2).Value) Then
- n = d2(Cells(i, 2).Value)
- Cells(i, 3) = ar(n, 1)
- Cells(i, 4) = ar(n, 2)
- Cells(i, "h") = ar(n, 3)
- Cells(i, "j") = ar(n, 4)
- Cells(i, "k") = ar(n, 5)
- End If
- Next
- End Sub
复制代码 |