|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub aa()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
Set sh = Sheets("总表")
arr = Application.Intersect(sh.UsedRange, sh.Columns(6))
For j = 2 To UBound(arr)
If Len(arr(j, 1)) > 0 Then
m = Month(arr(j, 1))
If d.exists(m) Then
Set d(m) = Union(d(m), sh.Cells(j, 1).Resize(1, 25))
Else
Set d(m) = Union(sh.[a1].Resize(1, 25), sh.Cells(j, 1).Resize(1, 25))
End If
End If
Next j
For j = Sheets.Count To 3 Step -1
Sheets(j).Delete
Next j
For j = 12 To 1 Step -1
If d.exists(j) Then
Sheets.Add after:=Sheets(2)
Sheets(3).Name = j & "月"
d(j).Copy Sheets(3).[a1]
End If
Next j
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub |
|