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将一个工作表根据条件拆分成多个工作表图文教程,希望能对大家有所帮助!

评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值