|
Sub test()
Dim i, arr, d, k
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.UsedRange
For i = 4 To UBound(arr)
k = Mid(arr(i, 8), 5, 2)
If Not d.exists(k) Then
Set d(k) = Sheets("总表").Range("a" & i).Resize(1, 9)
Else
Set d(k) = Union(d(k), Sheets("总表").Range("a" & i).Resize(1, 9))
End If
Next
kk = d.keys
For i = 0 To d.Count - 1
Worksheets.Add after:=Worksheets(Worksheets.Count)
Worksheets(i + 2).Name = kk(i) & "月"
With activeworksheet
Worksheets("总表").Range("a1").Resize(3, 9).Copy Range("a1")
d(kk(i)).Copy Range("a4")
End With
Next
End Sub |
|