自动分表轻松搞定

数字职场

@江苏仲勇 · 2011年6月13日第23期

相信不少朋友都遇到过这样棘手的问题，把总表中的大量的数据拆分成多个子表。常规的方法是排序后分类拆分工作表，这个过程要不停地复制、粘贴数据，很是麻烦。我提供一个简单的方法，制作一个“拆分总表”按钮。在“总表”中利用“控件工具箱”绘制一个命令按钮，在该按钮中输入代码（完整代码下载地址：http://www.icpcw.com/bzsoft）：

'删除所有分表（只保留名为 "总表"的工作表）

For Each sht In Sheets

If sht.Name <> "总表" Then sht.Delete

'加入新表，避免破坏原数据中的公式或格式

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） '在原工作表中生成文本符号

For i = 2 To irow

H.Add .Cells（i， ICol）， CStr（.Cells（i， ICol））

'建立一个不重复的筛选条件

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， ICol））） '消除新工作表中文本符号

Next j

.Cells.AutoFilter

Debug.Print H（i）

Next i

.Delete '操作表此时已多余，故删除

End With

A.Parent.Activate '激活汇总表的单元格

以后，单击“拆分总表”按钮，在弹出的对话框中输入分表字段的列号（例如按D列拆分则输入“4”），点击“确定”按钮即可。

自动分表 轻松搞定

自动分表轻松搞定