excel将一个工作表根据条件拆分成多个工作表图文教程

本例介绍在excel中如何将一个工作表根据条件拆分成多个工作表。

注意：很多朋友反映sheets(i).delete这句代码出错，要注意下面第一个步骤，要拆分的数据工作表名称为“数据源”，而不是你新建工作簿时的sheet1这种。手动改成“数据源”即可。

操作步骤：

原始数据表如下（名称为：数据源），需要根据B列人员姓名拆分成每个人一个工作表。

点击【开发工具】-【Visual Basic】或者Alt+F11的快捷键进入VBE编辑界面。

如下图所示插入一个新的模块。

如下图，粘贴下列代码在模块中：

复制内容到剪贴板

1. Sub CFGZB()   
2.   
3.     Dim myRange As Variant   
4.   
5.     Dim myArray   
6.   
7.     Dim titleRange As Range   
8.   
9.     Dim title As String   
10.   
11.     Dim columnNum As Integer   
12.   
13.     myRange = Application.InputBox(prompt:="请选择标题行：", Type:=8)   
14.   
15.     myArray = WorksheetFunction.Transpose(myRange)   
16.   
17.     Set titleRange = Application.InputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：“姓名”", Type:=8)   
18.   
19.     title = titleRange.Value   
20.   
21.     columnNum = titleRange.Column   
22.   
23.     Application.ScreenUpdating = False   
24.   
25.     Application.DisplayAlerts = False   
26.   
27.     Dim i&, Myr&, Arr, num&   
28.   
29.     Dim d, k   
30.   
31.     For i = Sheets.Count To 1 Step -1   
32.   
33.         If Sheets(i).Name <> "数据源" Then   
34.   
35.             Sheets(i).Delete   
36.   
37.         End If   
38.   
39.     Next i   
40.   
41.     Set d = CreateObject("Scripting.Dictionary")   
42.   
43.     Myr = Worksheets("数据源").UsedRange.Rows.Count   
44.   
45.     Arr = Worksheets("数据源").Range(Cells(2, columnNum), Cells(Myr, columnNum))   
46.   
47.     For i = 1 To UBound(Arr)   
48.   
49.         d(Arr(i, 1)) = ""  
50.   
51.     Next   
52.   
53.     k = d.keys   
54.   
55.     For i = 0 To UBound(k)   
56.   
57.         Set conn = CreateObject("adodb.connection")   
58.   
59.         conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName   
60.   
61.         Sql = "select * from [数据源$] where " & title & " = '" & k(i) & "'"  
62.   
63.         Worksheets.Add after:=Sheets(Sheets.Count)   
64.   
65.         With ActiveSheet   
66.   
67.             .Name = k(i)   
68.   
69.             For num = 1 To UBound(myArray)   
70.   
71.                 .Cells(1, num) = myArray(num, 1)   
72.   
73.             Next num   
74.   
75.             .Range("A2").CopyFromRecordset conn.Execute(Sql)   
76.   
77.         End With   
78.   
79.         Sheets(1).Select   
80.   
81.         Sheets(1).Cells.Select   
82.   
83.         Selection.Copy   
84.   
85.         Worksheets(Sheets.Count).Activate   
86.   
87.         ActiveSheet.Cells.Select   
88.   
89.         Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _   
90.   
91.                                SkipBlanks:=False, Transpose:=False   
92.   
93.         Application.CutCopyMode = False   
94.   
95.     Next i   
96.   
97.     conn.Close   
98.   
99.     Set conn = Nothing   
100.   
101.     Application.DisplayAlerts = True   
102.   
103.     Application.ScreenUpdating = True   
104.   
105. End Sub   
106.   

5、如下图所示，插入一个控件按钮，并指定宏到刚才插入的模块代码。

6、点击插入的按钮控件，根据提示选择标题行和要拆分的列字段，本例选择“姓名”字段拆分，当然也可以选择C列的“名称”进行拆分，看实际需求。

7、代码运行完毕后在工作簿后面会出现很多工作表，每个工作表都是单独一个人的数据。具体如下图所示：

8、注意：

1）原始数据表要从第一行开始有数据，并且不能有合并单元格；

2）打开工作簿时需要开启宏，否则将无法运行代码。

以上就是excel将一个工作表根据条件拆分成多个工作表图文教程，希望能对大家有所帮助！