|
下面的朋友介绍excel将一个工作表根据条件拆分成多个工作表的方法，对于经常使用excel的朋友很有帮助，推荐到，有需要的朋友可以过来参考一下，希望能对大家有所帮助 本例介绍在excel中如何将一个工作表根据条件拆分成多个工作表。 注意：很多朋友反映sheets(i).delete这句代码出错，要注意下面第一个步骤，要拆分的数据工作表名称为“数据源”，而不是你新建工作簿时的sheet1这种。手动改成“数据源”即可。 操作步骤： 原始数据表如下（名称为：数据源），需要根据B列人员姓名拆分成每个人一个工作表。 
点击【开发工具】-【Visual Basic】或者Alt+F11的快捷键进入VBE编辑界面。 
如下图所示插入一个新的模块。 
如下图，粘贴下列代码在模块中： 复制内容到剪贴板 - SubCFGZB()
- DimmyRangeAsVariant
- DimmyArray
- DimtitleRangeAsRange
- DimtitleAsString
- DimcolumnNumAsInteger
- myRange=Application.InputBox(prompt:="请选择标题行：",Type:=8)
- myArray=WorksheetFunction.Transpose(myRange)
- SettitleRange=Application.InputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：“姓名”",Type:=8)
- title=titleRange.Value
- columnNum=titleRange.Column
- Application.ScreenUpdating=False
- Application.DisplayAlerts=False
- Dimi&,Myr&,Arr,num&
- Dimd,k
- Fori=Sheets.CountTo1Step-1
- IfSheets(i).Name<>"数据源"Then
- Sheets(i).Delete
- EndIf
- Nexti
- Setd=CreateObject("Scripting.Dictionary")
- Myr=Worksheets("数据源").UsedRange.Rows.Count
- Arr=Worksheets("数据源").Range(Cells(2,columnNum),Cells(Myr,columnNum))
- Fori=1ToUBound(Arr)
- d(Arr(i,1))=""
- Next
- k=d.keys
- Fori=0ToUBound(k)
- Setconn=CreateObject("adodb.connection")
- conn.Open"provider=microsoft.jet.oledb.4.0;extendedpropertIEs=excel8.0;datasource="&ThisWorkbook.FullName
- Sql="select*from[数据源$]where"&title&"='"&k(i)&"'"
- Worksheets.Addafter:=Sheets(Sheets.Count)
- WithActiveSheet
- .Name=k(i)
- Fornum=1ToUBound(myArray)
|
