- Sub tst()
- Dim arr, d As Object, brr(), n%, m%
- Set d = CreateObject("scripting.dictionary")
- arr = Sheets("数据").Range("C2").CurrentRegion
- For i = 2 To UBound(arr)
- If Year(arr(i, 3)) = [B4] And Month(arr(i, 3)) = [C4] Then
- keyy = arr(i, 1) & arr(i, 2)
- If Not d.exists(keyy) Then
- n = n + 1
- d(keyy) = n
- ReDim Preserve brr(1 To 18, 1 To n)
- brr(1, n) = arr(i, 2)
- brr(2, n) = arr(i, 1)
- brr(Asc(arr(i, 6)) - 62, n) = brr(Asc(arr(i, 6)) - 62, n) + arr(i, 7)
- brr(18, n) = brr(18, n) + arr(i, 7)
- Else
- m = d(keyy)
- brr(Asc(arr(i, 6)) - 62, m) = brr(Asc(arr(i, 6)) - 62, m) + arr(i, 7)
- brr(18, m) = brr(18, m) + arr(i, 7)
- End If
- End If
- Next
- [B6].Resize(UBound(brr, 2), 18) = Application.Transpose(brr)
- End Sub
复制代码 |