Excel按类别分割多个文件--使用VBS建立一个宏

情景：对一个多类别总数据文件，按类别分隔成多个文件。
如下图有ABC三个类别的Excel文件，将分成ABC三个文件。

image.png

操作流程如下

新建一个宏

image.png

代码复制粘贴，保存，关闭。

image.png

回到原Excel文档界面,或者重新打开文件，选择启用宏（若提示要如此操作）。

image.png

image.png

image.png

image.png

完成！结果如下

image.png

代码如下

Sub 按类别分隔多个文件()

Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%

c = Application.InputBox("请输入拆分列号:", , 4) '默认选择第三列，可修改

If c = 0 Then Exit Sub

Application.ScreenUpdating = False

Application.DisplayAlerts = False

arr = [a1].CurrentRegion

lc = UBound(arr, 2)

Set rng = [a1].Resize(, lc)

Set d = CreateObject("scripting.dictionary")

For i = 2 To UBound(arr)

If Not d.Exists(arr(i, c)) Then

Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)

Else

Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))

End If

Next

k = d.Keys

t = d.Items

For i = 0 To d.Count - 1

With Workbooks.Add(xlWBATWorksheet)

rng.Copy .Sheets(1).[a1]

t(i).Copy .Sheets(1).[a2]

.SaveAs Filename:=ThisWorkbook.Path & "\" & k(i) & ".xlsx"

.Close

End With

Next

Application.DisplayAlerts = True

Application.ScreenUpdating = True

MsgBox "完毕"


End Sub

文尾图.jpg

--by Affandi ⊙▽⊙