按某列相同的值分到各工作表中备课讲稿.doc

《按某列相同的值分到各工作表中备课讲稿.doc》由会员上传分享，免费在线阅读，更多相关内容在教育资源-天天文库。

1、按某列相同的值分到各工作表中精品文档这个是近期常遇见的一个问题题，大意是这样的：有一个总表，总表中包含N行标题列与M行数据，要将其中一列数据（比如A列）中相同值对应的行，分配到新工作表中。如果数据量少的话，我们可以用筛选，再将结果复制到新工作表来完成，但数据一多，我们还是用VBA来完成吧：）。首先，选择标题最后一行与条件数据所在列的单元格，比如共有3行标题，按第二列分配数据，就选择B3格，然后运行下面的宏：Sub按某列相同的值分到各工作表中() OnErrorResumeNext DimIAsInteger,NAsInteger DimS

2、RAsInteger,ERAsInteger,FCAsInteger DimTSAsString,SSAsString DimOSAsWorksheet,NSAsWorksheet,KSAsWorksheet SetOS=ActiveSheet FC=ActiveCell.Column SR=ActiveCell.Row+1 ER=ActiveCell.SpecialCells(xlCellTypeLastCell).Row Application.ScreenUpdating=False ForI=SRToER    TS=Cells(

3、I,FC)    IfWorksheetFunction.CountIf(Range(Cells(SR,FC),Cells(I,FC)),TS)=1Then        SetNS=ActiveWorkbook.Worksheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))        N=0        Do            IfNThen                SS=TS&"("&N&")"            Else     

4、           SS=TS            EndIf            SetKS=Worksheets(SS)            IfKSIsNothingThen                NS.Name=SS                ExitDo            Else                SetKS=Nothing            EndIf            N=N+1        Loop        OS.Select        Rows(SR-1).Sel

5、ect        Selection.AutoFilter        Selection.AutoFilterField:=FC,Criteria1:=TS        ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy        收集于网络，如有侵权请联系管理员删除精品文档NS.Select        ActiveSheet.Paste        OS.Select        Selection.AutoFilter    EndIf Next

6、Cells(SR-1,FC).Select Application.ScreenUpdating=True EndSub运行宏后的结果——生成的工作表以数据为名称，如果存在，则为原来的名称加“(N)”，工作表按原来的顺序排列在最后。附上实例（包含上面的宏）按某列相同的值分到各工作表中.rar最后是格式问题，宏生成的表，行高与列宽都变了，如果需要设定格式：1、设定列宽： 选择原总表，复制，再选择所有生成的工作表，最后用选择性粘贴——列宽即可。  2、设定标题的行高： 选择原总表的标题，复制，再选择所有生成的工作表，选择标题列，再粘贴，就处理

7、完了。这不？是不是又快又省事呀！收集于网络，如有侵权请联系管理员删除