|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Private Sub CommandButton1_Click()
- tms = Timer
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- For Each sht In Sheets
- If sht.Name <> ActiveSheet.Name Then sht.Delete
- Next
- Application.DisplayAlerts = True
- Set d = CreateObject("scripting.dictionary")
- arr = [g1].CurrentRegion
- Set Rng = [g1].Resize(1, 4)
- For i = 2 To UBound(arr)
- If Not d.exists(arr(i, 1)) Then
- Set d(arr(i, 1)) = Range("g" & i).Resize(1, 4)
- Else
- Set d(arr(i, 1)) = Union(d(arr(i, 1)), Range("g" & i).Resize(1, 4))
- End If
- Next
- x = d.Keys
- For k = 0 To UBound(x)
- Set sht = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)
- sht.Name = x(k)
- d.Items()(k).Copy sht.[a2]
- Rng.Copy sht.[a1]
- sht.[a1].CurrentRegion.Sort sht.[b1], 1, , , , , , 1
- Next
- Application.ScreenUpdating = True
- MsgBox Format(Timer - tms, "拆分完成,共耗时:0.00秒"), 64, "时间统计"
- End Sub
复制代码 |
评分
-
2
查看全部评分
-
|