先来看看问题
如图,表中保存了许多数据,现需要按A列日期拆分到不同的工作簿中。
![3fdc6d20bb21e760e4484a881dabd3d8.png](https://i-blog.csdnimg.cn/blog_migrate/3da7087a7d0415e73ed4478f7d67d147.jpeg)
图1 待拆分的数据
![1b6017bbc88af46de64ab987f3bbd4a6.png](https://i-blog.csdnimg.cn/blog_migrate/4f9c931d1c50fc9bb3bee9874772f35f.jpeg)
图2 拆分所得的工作簿
![1c68480dd1ef7e86e831258064df98b8.png](https://i-blog.csdnimg.cn/blog_migrate/c1a9e21cffc60f223e92094c8b02b4ea.jpeg)
图3 拆分所得工作簿中的数据
解决办法
步骤1:在工作簿中按打开VBE窗口,在VBE窗口中插入一个模块。
![b4791b2e5cfd1d21930eb6f7d970abf7.png](https://i-blog.csdnimg.cn/blog_migrate/b66ec6320d4834f9ce81d449befea018.jpeg)
图4 插入模块
步骤2:在插入的模块中写入下面的代码。
Sub 拆分数据到工作簿() Application.ScreenUpdating = False Dim Dic As Object, Irow As Long, i As Long, ToFolder As String Set Dic = CreateObject("Scripting.Dictionary") Irow = ActiveSheet.UsedRange.Rows.Count ToFolder = ThisWorkbook.Path & "拆分结果" If Len(Dir(ToFolder, vbDirectory)) = 0 Then MkDir ToFolder Dim DateSht As Worksheet, ToSht As Worksheet, arr As Variant, Icol As Long, Cel As Range Set DateSht = ActiveSheet On Error GoTo er: Set Cel = Application.InputBox(prompt:="要按哪列的信息拆分数据?请选择该列的任意一个单元格:", Title:="设置", Type:=8) Icol = Cel.Cells(1).Column On Error GoTo 0 For i = 2 To Irow Dic(DateSht.Cells(i, Icol).Value) = DateSht.Cells(i, Icol).Value Next i DateSht.Cells(1, "XFD").Value = DateSht.Cells(1, Icol).Value arr = Dic.keys For i = 0 To Dic.Count - 1 DateSht.Cells(2, "XFD").Value = arr(i) Worksheets.Add.Name = arr(i) Set ToSht = ActiveSheet DateSht.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DateSht.Range("XFD1:XFD2"), CopyToRange:=ToSht.Range("A1") ToSht.Cells.EntireColumn.AutoFit ToSht.Move ActiveWorkbook.SaveAs Filename:=ToFolder & "" & arr(i) & ".xlsx" ActiveWorkbook.Close Next i DateSht.Columns("XFD:XFD").Delete Application.ScreenUpdating = True MsgBox "数据拆分完成,单击【确定】查看拆分结果。", vbInformation Shell "explorer.exe " & ToFolder & "", vbNormalFocuser:End Sub
![41266c75e3258fd7017395629db9ceb6.png](https://i-blog.csdnimg.cn/blog_migrate/7505f84cbac8baf5f857533e33e73507.jpeg)
图5 写入的代码
步骤3:返回Excel界面,执行这个过程,就能自动完成数据拆分任务了。
![1685362b800331ad0283d7e9a1e2b50b.png](https://i-blog.csdnimg.cn/blog_migrate/417931b9cb1508b2e2b22b7c8b524a1f.jpeg)
图5 执行代码拆分数据
我是叶枫,感谢你的阅读。
点击下面的“了解更多”可以观看演示视频。