|
- Sub Macro1()
- Dim arr, brr, d, i&, j%, m%, k%
- Set d = CreateObject("scripting.dictionary")
- arr = Sheet1.Range("a2").CurrentRegion
- w = Array("广州", "南宁") '区域顺序
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 2)
- For m = 1 To 6
- yf = Format(m, "00") & "月"
- For k = 0 To UBound(w)
- For i = 2 To UBound(arr)
- If arr(i, 2) = yf And arr(i, 4) = w(k) Then
- zf = yf & "," & arr(i, 4)
- If Not d.exists(zf) Then
- s = s + 1
- d(zf) = s
- brr(s, 1) = s
- brr(s, 2) = yf
- brr(s, 3) = arr(i, 4)
- For j = 6 To UBound(arr, 2)
- brr(s, j - 2) = arr(i, j)
- Next
- Else
- n = d(zf)
- For j = 6 To UBound(arr, 2)
- brr(n, j - 2) = brr(n, j - 2) + arr(i, j)
- Next
- End If
- End If
- Next
- Next
- Next
- Sheet2.Activate
- [a1:c1] = Array("序号", "月份", "区域")
- Sheet1.[f2:q2].Copy [d1]
- Range("a2").Resize(d.Count, UBound(brr, 2)) = brr
- End Sub
复制代码 |
|