|
发表于 2016-3-20 21:47
|
显示全部楼层
本楼为最佳答案
- Sub Macro1()
- Dim arr, brr, d, i&
- Set d = CreateObject("scripting.dictionary")
- arr = Sheet2.Range("a1").CurrentRegion
- ReDim brr(1 To UBound(arr), 1 To 3)
- Sheet1.Activate: ym = [e1]
- For i = 2 To UBound(arr)
- If DateDiff("m", ym, arr(i, 1)) <> 0 Then
- arr(i, 3) = 0
- arr(i, 4) = 0
- End If
- If Not d.exists(arr(i, 2)) Then
- s = s + 1
- d(arr(i, 2)) = s
- brr(s, 1) = arr(i, 2)
- brr(s, 2) = arr(i, 3)
- brr(s, 3) = arr(i, 4)
- Else
- n = d(arr(i, 2))
- brr(n, 2) = brr(n, 2) + arr(i, 3)
- brr(n, 3) = brr(n, 3) + arr(i, 4)
- End If
- Next
- ActiveWindow.DisplayZeros = False
- [a3:c2000] = ""
- Range("a3").Resize(d.Count, 3) = brr
- End Sub
复制代码 |
|