|
附件请测试- Private Sub CommandButton1_Click()
- Dim arr, arr1, i&, j&, d As Object
- Set d = CreateObject("scripting.dictionary")
- arr = [a1].CurrentRegion
- arr1 = Sheets(2).[a2].CurrentRegion
- For i = 2 To UBound(arr)
- d(arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3)) = d(arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3)) + arr(i, 4)
- Next i
- For i = 2 To UBound(arr1)
- For j = 3 To UBound(arr1, 2)
- arr1(i, j) = d(arr1(i, 1) & "," & arr1(1, j) & "," & arr1(i, 2))
- Next j
- Next i
- Sheets(2).[a2].CurrentRegion = arr1
- End Sub
复制代码 |
|