Excel按分类一键拆分工作表

准备工作：微软Office Excel

 

操作步骤：

第一步

 

 

第二步

 

 第三步，粘贴代码

Sub 分类表格()
Dim dicc As New Dictionary
Application.DisplayAlerts = False
If Sheets.Count >= 2 Then
For i = 2 To Sheets.Count
Sheets(2).Select
ActiveWindow.SelectedSheets.Delete
Next
End If
ck = InputBox("请输入索引列")
If Not IsNumeric(ck) Then
MsgBox "请输入数字"
Exit Sub
End If
ls = Range("a1").End(xlToRight).Column
bt = Range("a1", Chr(64 + ls) & "1")
arr = Range("a2", Chr(64 + ls) & Range("f1000000").End(xlUp).Row)
For i = LBound(arr) To UBound(arr)
dicc(arr(i, ck)) = 1
Next

For i = 0 To dicc.Count - 1
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = dicc.Keys(i)
Sheets(Sheets.Count).Range("a1", Chr(64 + ls) & "1") = bt
For io = LBound(arr) To UBound(arr)
If arr(io, ck) = dicc.Keys(i) Then
dw = Range("a65536").End(xlUp).Row + 1
For ip = 1 To ls
Range(Chr(64 + ip) & dw) = arr(io, ip)
Next
End If
Next

Next
Sheets(1).Select
Application.DisplayAlerts = True
End Sub

第四步，添加引用

 

 

 

 第五步，插入按钮，选择对应宏名称。