|
- Sub Macro1()
- Dim arr, brr, crr, drr, d, d2, i&, j&, k&, x$
- Set d = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- Sheet1.Activate
- arr = Range("a3").CurrentRegion
- brr = Sheet2.Range("a3").CurrentRegion
- crr = Sheet3.Range("a3").CurrentRegion
- drr = arr
- Range("b4:j65536").ClearContents
- For i = 2 To UBound(brr)
- For j = 2 To UBound(brr, 2)
- x = crr(i, 1) & "," & crr(i, j + 4)
- d(x) = brr(i, j)
- s = 0
- For k = j + 1 To UBound(brr, 2)
- s = s + brr(i, k)
- Next
- d2(x) = s
- Next
- Next
- For i = 2 To UBound(arr)
- For j = 2 To UBound(arr, 2)
- x = arr(i, 1) & "," & arr(1, j)
- arr(i, j) = d2(x)
- drr(i, j) = d2(x) + d(x)
- Next
- Next
- Range("a3").Resize(UBound(arr), UBound(arr, 2)) = arr
- Range("l3").Resize(UBound(drr), UBound(drr, 2)) = drr
- End Sub
复制代码 |
评分
-
查看全部评分
|