|
-
相信不少朋友都遇到过这样棘手的问题，把总表中的大量的数据拆分成多个子表。常规的方法是排序后分类拆分工作表，这个过程要不停地复制、粘贴数据，很是麻烦。我提供一个简单的方法，制作一个“拆分总表”按钮。在“总表”中利用“控件工具箱”绘制一个命令按钮，在该按钮中输入代码： '删除所有分表(只保留名为 "总表"的工作表) For Each sht In Sheets If sht.Name <> "总表" Then sht.Delete Next '加入新表，避免破坏原数据中的公式或格式 Sheets("总表").Copy Before:=Sheets(1) ICol = Application.InputBox("请输入你所要拆分的列：(如按D列拆分请输入4)"， "提示："， "2"， Type:=1) If ICol = "" Then Exit Sub On Error Resume Next With Sheets("总表 (2)") irow = .[a1].CurrentRegion.Rows.Count For i = 2 To irow Cells(i， ICol) = " ' " & Cells(i， ICol) '在原工作表中生成文本符号 Next For i = 2 To irow H.Add .Cells(i， ICol)， CStr(.Cells(i， ICol)) Next '建立一个不重复的筛选条件 For i = 1 To H.Count .Cells.AutoFilter field:=ICol， Criteria1:=H(i) Sheets.Add(after:=Sheets(Sheets.Count)).Name = H(i) .[a1].CurrentRegion.Copy Sheets(CStr(H(i))).[a1] '自动筛选，并复制到新建的表中 irow1 = [a1].CurrentRegion.Rows.Count For j = 2 To irow1 Cells(j， ICol) = Right(Cells(j， ICol)， Len(Cells(j， file://D:\Program Files\cpcw\PCWReadSys2012\skin\A冬日暖阳\file.htm 2012-2-1 《中国计算机年鉴 2007》页码，2/2 ICol))) '消除新工作表中文本符号 Next j .Cells.AutoFilter Debug.Print H(i) Next i .Delete '操作表此时已多余，故删除 End With A.Parent.Activate '激活汇总表的单元格
以后，单击“拆分总表”按钮，在弹出的对话框中输入分表字段的列号(例如按D列拆分则输入“4”)，点击“确定”按钮即可。 |
