|
- Sub Macro1()
- Dim arr, brr, crr, d, k&, i%, l%, j%
- Set d = CreateObject("scripting.dictionary")
- arr = Range("b3:k" & Range("k65536").End(xlUp).Row)
- brr = [m1:z1]
- ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
- For i = 1 To UBound(brr, 2) - 3
- For j = i To i + 3
- d(brr(1, j)) = 1
- Next
- For k = 1 To UBound(arr)
- For l = 1 To UBound(arr, 2)
- crr(k, i) = crr(k, i) + d(arr(k, l))
- Next
- Next
- d.RemoveAll
- Next
- Range("y3").Resize(UBound(crr), UBound(crr, 2)) = crr
- End Sub
复制代码 |
|