自动按列分组拆分excel工作表

《自动按列分组拆分excel工作表》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。

1、自动按列分组拆分excel工作表可以将一个excel工作表按照指定列分组拆分成多个工作表，甚至可以将已经拆分的多个工作表再次拆分成单独的excel文件。略懂一些编程语言的可以将代码改编，以达到批量拆分多个工作表，或者批量合并多个excel文件、工作表，有了vbs的支持，只要你想的到就能做的到！拷贝代码时请注意自动换行格式。自动拆分工作表自动创建文件夹自动保存单独的excel文件至文件夹自动过滤空行，如果存在大量集中的空行请尽量删除空行，因为大量空行会影响运行效率使用方法：打开待拆分的excel文档，按ALT+F11进入vba模式，鼠标选

2、【插入】---【模块】，在右侧新建的模块内将准备好的代码粘贴进去，然后按F5，直接运行。此时会让你选择标题行和待分组的列标题。选完确定开始自动拆分，此时鼠标会不停闪动，根据文档大小，运行一段时间，并不是死机，一般会有几分钟时间，如果你的文档有上万行那会更久。你只需关注文档所在目录是否已经自动创建文件夹并创建excel文件。‘vbs代码开始SubCFGZB()DimmyRangeAsVariantDimmyArrayDimtitleRangeAsRangeDimtitleAsStringDimShNameAsStringDimcolumn

3、NumAsIntegermyRange=Application.InputBox(prompt:="请选择标题行：",Type:=8)myArray=WorksheetFunction.Transpose(myRange)SettitleRange=Application.InputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：姓名",Type:=8)title=titleRange.ValuecolumnNum=titleRange.ColumnApplication.VolatileShName=Ac

4、tiveSheet.NameApplication.ScreenUpdating=FalseApplication.DisplayAlerts=FalseDimi&,Myr&,Arr,num&Dimd,kFori=Sheets.CountTo1Step-1IfSheets(i).Name<>ShNameThenSheets(i).DeleteEndIfNextiSetd=CreateObject("Scripting.Dictionary")Myr=Worksheets(ShName).UsedRange.Rows.CountArr=W

5、orksheets(ShName).Range(Cells(2,columnNum),Cells(Myr,columnNum))Fori=1ToUBound(Arr)d(Arr(i,1))=""Nextk=d.keysFori=0ToUBound(k)Ifk(i)<>""ThenSetconn=CreateObject("adodb.connection")conn.Open"provider=microsoft.jet.oledb.4.0;extendedproperties=excel8.0;datasource="&ThisWor

6、kbook.FullNameSql="select*from["&ShName&"$]where"&title&"='"&k(i)&"'"Worksheets.Addafter:=Sheets(Sheets.Count)WithActiveSheet.Name=k(i)Fornum=1ToUBound(myArray).Cells(1,num)=myArray(num,1)Nextnum.Range("A2").CopyFromRecordsetconn.Execute(Sql)EndWithSheets(1).SelectSheets

7、(1).Cells.SelectSelection.CopyWorksheets(Sheets.Count).ActivateActiveSheet.Cells.SelectSelection.PasteSpecialPaste:=xlPasteFormats,Operation:=xlNone,_SkipBlanks:=False,Transpose:=FalseApplication.CutCopyMode=FalseEndIfNexticonn.CloseSetconn=NothingApplication.DisplayAler

8、ts=TrueApplication.ScreenUpdating=True‘拆分至工作表完毕，开始拆分至单独文件，如无需拆分至文件，请将以下代码删除，保留最后一行EndSub结束语DimshtAsWork