1、自动按列分组拆分 excel 工作表可以将一个 excel 工作表按照指定列分组拆分成多个工作表，甚至可以将已经拆分的多个工作表再次拆分成单独的 excel 文件。略懂一些编程语言的可以将代码改编，以达到批量拆分多个工作表，或者批量合并多个 excel 文件、工作表，有了 vbs 的支持，只要你想的到就能做的到！拷贝代码时请注意自动换行格式。自动拆分工作表自动创建文件夹自动保存单独的 excel 文件至文件夹自动过滤空行，如果存在大量集中的空行请尽量删除空行，因为大量空行会影响运行效率使用方法：打开待拆分的 excel 文档，按 ALT+F11 进入 vba 模式，鼠标选【插入】-【模块】 ，
2、在右侧新建的模块内将准备好的代码粘贴进去，然后按 F5，直接运行。此时会让你选择标题行和待分组的列标题。选完确定开始自动拆分，此时鼠标会不停闪动，根据文档大小，运行一段时间，并不是死机，一般会有几分钟时间，如果你的文档有上万行那会更久。你只需关注文档所在目录是否已经自动创建文件夹并创建 excel 文件。vbs 代码开始Sub CFGZB()Dim myRange As VariantDim myArrayDim titleRange As RangeDim title As StringDim ShName As StringDim columnNum As IntegermyRange =
3、 Application.InputBox(prompt:=“请选择标题行：“, Type:=8)myArray = WorksheetFunction.Transpose(myRange)Set titleRange = Application.InputBox(prompt:=“请选择拆分的表头，必须是第一行，且为一个单元格，如：姓名“, Type:=8)title = titleRange.ValuecolumnNum = titleRange.ColumnApplication.VolatileShName = ActiveSheet.NameApplication.ScreenUpd
4、ating = FalseApplication.DisplayAlerts = FalseDim iextended properties=excel 8.0;data source=“ & ThisWorkbook.FullNameSql = “select * from “ & ShName & “$ where “ & title & “ = “ & k(i) & “Worksheets.Add after:=Sheets(Sheets.Count)With ActiveSheet.Name = k(i)For num = 1 To UBound(myArray).Cells(1, n
5、um) = myArray(num, 1)Next num.Range(“A2“).CopyFromRecordset conn.Execute(Sql)End WithSheets(1).SelectSheets(1).Cells.SelectSelection.CopyWorksheets(Sheets.Count).ActivateActiveSheet.Cells.SelectSelection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseAppli
6、cation.CutCopyMode = FalseEnd IfNext iconn.CloseSet conn = NothingApplication.DisplayAlerts = TrueApplication.ScreenUpdating = True拆分至工作表完毕，开始拆分至单独文件，如无需拆分至文件，请将以下代码删除，保留最后一行 End Sub 结束语Dim sht As WorksheetDim MyBook As WorkbookSet MyBook = ActiveWorkbookSet fso = CreateObject(“scripting.filesystemobject“)fso.createfolder (MyBook.Path & “ & ShName)For Each sht In MyBook.SheetsIf sht.Name ShName Thensht.CopyActiveWorkbook.SaveAs Filename:=MyBook.Path & “ & ShName & “ & sht.Name, FileFormat:=xlNormalActiveWorkbook.CloseEnd IfNextMsgBox “文件已经被分拆完毕!“End Subvbs 代码结束
