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

  发布时间:2015-01-04 09:23:40   作者:佚名   我要评论
下面脚本之家的朋友介绍excel将一个工作表根据条件拆分成多个工作表的方法,对于经常使用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将一个工作表根据条件拆分成多个工作表图文教程,希望能对大家有所帮助!

相关文章

最新评论