|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 lsc900707 于 2018-5-3 20:39 编辑
在本目录下先建好一个“拆分好的”的文件夹:
- Sub 拆分文件()
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- arr = [a2].CurrentRegion
- Set Rng = [a2].Resize(, 22)
- Set d = CreateObject("scripting.dictionary")
- For i = 3 To UBound(arr)
- s = Right(Split(arr(i, 20), "-")(0), 1)
- If Not d.Exists(s) Then
- Set d(s) = Cells(i + 1, 1).Resize(1, 22)
- Else
- Set d(s) = Union(d(s), Cells(i + 1, 1).Resize(1, 22))
- End If
- Next
- k = d.Keys
- t = d.Items
- For i = 0 To d.Count - 1
- With Workbooks.Add
- Rng.Copy .Sheets(1).[a1]
- t(i).Copy .Sheets(1).[a2]
- .SaveAs Filename:=ThisWorkbook.Path & "\拆分好的" & k(i), FileFormat:=xlWorkbookDefault
- .Close
- End With
- Next
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- MsgBox "完毕"
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|