Excel按条件拆分为多个文件

252次阅读
没有评论

下图为某平台发货信息。

Excel按条件拆分为多个文件

需要按照发货人姓名,将此表拆分为若干表格。

ALT+F11打开VBE,点击插入→模块。

Excel按条件拆分为多个文件
Excel按条件拆分为多个文件

输入代码:

Sub 保留表头拆分数据为若干新工作簿()
Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
c = Application.InputBox("请输入拆分列号", , 4, , , , , 1)
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) & ".xls"
.Close
End With
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完毕"
End Sub

点击按钮执行。

Excel按条件拆分为多个文件

这里输入4。

Excel按条件拆分为多个文件

点击确定后开始执行。

完成。

Excel按条件拆分为多个文件

拆分后的文件显示在桌面。

Excel按条件拆分为多个文件

拆分后的文件。

Excel按条件拆分为多个文件

代码来源:https://blog.csdn.net/ntotl/article/details/79141314

1
雨米
版权声明:本站原创文章,由 雨米2022-02-21发表,共计857字。
转载说明:除特殊说明外本站文章皆由CC-4.0协议发布,转载请注明出处。
评论(没有评论)