参与一下。。。
- Sub ykcbf() '//2024.4.8
- Set d = CreateObject("Scripting.Dictionary")
- With Sheets("Sheet1")
- r = .Cells(Rows.Count, 2).End(3).Row
- arr = .[a1].Resize(r, 15)
- End With
- For i = 2 To UBound(arr)
- yf = Format(arr(i, 3), "yyyy年m月")
- s = Left(arr(i, 7), 4) & "|" & arr(i, 9) & "|" & yf
- d(s) = d(s) + arr(i, 12)
- Next
- With Sheets("统计汇总表")
- r = .Cells(Rows.Count, 1).End(3).Row
- arr = .[a1].Resize(r, 30)
- For i = 2 To UBound(arr)
- For j = 8 To UBound(arr, 2)
- s = arr(i, 4) & "|" & arr(i, 5) & "|" & arr(1, j)
- If d.exists(s) Then
- arr(i, j) = d(s)
- End If
- Next
- Next
- .[a1].Resize(r, 30) = arr
- End With
- Set d = Nothing
- MsgBox "OK!"
- End Sub
复制代码
|