如何将一个表按客户名称分出多个单独的表格，请大神指点，谢谢！急

莫小嘿

莫小嘿 发表于 2017-9-27 10:47
请大侠具体分享下怎么操作的？

谢谢大侠的指点，已经成功使用了，真棒！！

lzqmsy

拆分成多个独立文件(回论坛).rar (14.5 KB, 下载次数: 21)

2017-9-27 12:47 上传

点击文件名下载附件

如果不会用再咨询我

lzqmsy

9.1-9.10揽收清单1.rar (767.27 KB, 下载次数: 6)

2017-9-27 13:19 上传

点击文件名下载附件

又做个分表的

莫小嘿

lzqmsy 发表于 2017-9-27 13:20
又做个分表的

请指教如何使用，表里提示拆分失败，说被禁用了宏，要在哪开启宏设置？

lzqmsy

莫小嘿 发表于 2017-9-27 16:36
请指教如何使用，表里提示拆分失败，说被禁用了宏，要在哪开启宏设置？

打开文件时要按提示选择启用宏,就可以了

戴眼镜的泥水匠

莫小嘿 发表于 2017-9-27 10:48
请大侠分享具体是如何操作的

大概就是这样的，你的数据做的太不规范了。

ykcbf1100

借题练习，总表原格式拆分为多工作簿，VBA

ykcbf1100

1. Sub ykcbf()    '// 2025.6.27 总表拆分为多工作簿
   
2.     Dim d As Object
   
3.     Dim p As String
   
4.     Dim ws As Workbook
   
5.     Dim sh As Worksheet
   
6.     Dim arr As Variant
   
7.     Dim bt As Long, col As Long
   
8.     Dim i As Long
   
9.     Dim s As String
   
10.     Dim k As Variant
    
11.     Dim wb As Workbook
    
12.     Dim tm As Double
    
13.     Application.ScreenUpdating = False
    
14.     Application.DisplayAlerts = False
    
15.     Set d = CreateObject("Scripting.Dictionary")
    
16.     p = ThisWorkbook.Path & ""
    
17.     Set ws = ThisWorkbook
    
18.     tm = Timer
    
19.     On Error GoTo ErrorHandler
    
20.     Set sh = ws.ActiveSheet
    
21.     arr = sh.UsedRange.Value
    
22.     bt = 1
    
23.     col = 2
    
24.     For i = bt + 1 To UBound(arr, 1)
    
25.         s = arr(i, col)
    
26.         If Len(s) = 0 Then Exit For
    
27.         d(s) = 1
    
28.     Next i
    
29.     For Each k In d.Keys
    
30.         sh.Copy
    
31.         Set wb = Workbooks(Workbooks.Count)
    
32.         With wb.Sheets(1)
    
33.             .Name = k
    
34.             .DrawingObjects.Delete
    
35.             .AutoFilterMode = False
    
36.             .Rows(bt).AutoFilter Field:=col, Criteria1:="<>" & k
    
37.             .UsedRange.Offset(bt).EntireRow.Delete
    
38.             .AutoFilterMode = False
    
39.         End With
    
40.         wb.SaveAs p & k & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    
41.         wb.Close SaveChanges:=False
    
42.     Next k
    
43. CleanUp:
    
44.     Set d = Nothing
    
45.     Application.ScreenUpdating = True
    
46.     Application.DisplayAlerts = True
    
47.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & "秒！"
    
48.     Exit Sub
    
49. ErrorHandler:
    
50.     MsgBox "发生错误: " & Err.Description
    
51.     Resume CleanUp
    
52. End Sub
    
53. 
    

复制代码