拆分工作簿

哈哈哈。

我要将这个工作簿按照省代码也就是A列拆分成工作簿，工作簿名就是省代码名，每个省代码对应一个一个工作簿，所有拆分的工作簿保存在一个目录下，求助各位大神该如何实现！

lsc900707

论坛内有很多“按列拆分”的案例可资参考！

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim wb As Workbook
   
5.   Dim ws As Worksheet
   
6.   Dim mypath$, myname$
   
7.   Dim d As Object
   
8.   Application.ScreenUpdating = False
   
9.   Application.DisplayAlerts = False
   
10.   Set d = CreateObject("scripting.dictionary")
    
11.   With Worksheets("sheet1")
    
12.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
13.     arr = .Range("a1:a" & r)
    
14.     For i = 2 To UBound(arr)
    
15.       If Not d.exists(arr(i, 1)) Then
    
16.         Set d(arr(i, 1)) = .Range("a1:n1")
    
17.       End If
    
18.       Set d(arr(i, 1)) = Union(d(arr(i, 1)), .Cells(i, 1).Resize(1, 14))
    
19.     Next
    
20.   End With
    
21.   
    
22.   For Each aa In d.keys
    
23.     Application.SheetsInNewWorkbook = 1
    
24.     Set wb = Workbooks.Add
    
25.     With wb
    
26.       With .Worksheets(1)
    
27.         d(aa).Copy .Range("a1")
    
28.       End With
    
29.       .SaveAs Filename:=ThisWorkbook.Path & "" & aa
    
30.       .Close False
    
31.     End With
    
32.   Next
    
33.   Application.ScreenUpdating = True
    
34.   MsgBox "数据拆分完毕！"
    
35. End Sub
    
36. 
    

复制代码

chxw68

朱版主说得对，这样的代码论坛上太多了。

哈哈哈。

chxw68 发表于 2019-3-5 16:09

请问一下 这个aa 是什么，我想把拆分好的工作簿都放在同一个目录下 该怎么实现，可以再帮我优化一下吗？谢谢啦!

chxw68

哈哈哈。 发表于 2019-3-6 10:59
请问一下 这个aa 是什么，我想把拆分好的工作簿都放在同一个目录下 该怎么实现，可以再帮我优化一下吗？ ...

就在同一个目录下呀！

哈哈哈。

chxw68 发表于 2019-3-6 11:06
就在同一个目录下呀！

若是 我要拆分的列是K列，又该如何实现？

哈哈哈。

chxw68 发表于 2019-3-5 16:09

可以帮我解释一下这串代码吗？刚开始接触很多不懂，谢谢啦。

chxw68

哈哈哈。 发表于 2019-3-7 18:27
可以帮我解释一下这串代码吗？刚开始接触很多不懂，谢谢啦。

建议百度吧，没精力解释。