vba編程常見(jiàn)實(shí)例

1、vba編程常有實(shí)例vba編程常有實(shí)例vba編程常有實(shí)例1、將excel匯總好的表，按字段拆分為多sheet的狀況：以以下列圖：代碼以下：Subcfs()DimGSArr()AsString企業(yè)名稱清單DimRcaAsIntegerA列數(shù)據(jù)行數(shù)DimiAsIntegerDimSnAsStringSn=Rca=Columns(A:A).End(xlDown).Row按第A列數(shù)據(jù)拆分，且第一行無(wú)歸并單元格ReDimGSArr(1To1)GSArr(1)=Cells(2,1)Fori=3ToRcaIfIsError(Cells(i,1),GSArr,0)ThenReDimPreserveGSArr(1

2、ToUBound(GSArr)+1)GSArr(UBound(GSArr)=Cells(i,1)EndIfNextIf=FalseThenRows(1:1).AutoFilterElseIf=TrueThenEndIfFori=1ToUBound(GSArr)Field:=1,Criteria1:=GSArr(i)After:=SheetsGSArr(i)Sheets(Sn).Sheets(Sn).ActivateNextSub2、將匯總的好的EXCEL表按字段拆分為多個(gè)工作薄代碼以下：SubCFGZB()DimmyRangeAsVariantDimmyArrayDimtitleRangeAs

3、RangeDimtitleAsStringDimcolumnNumAsIntegermyRange=(prompt:=請(qǐng)選擇標(biāo)題行：,Type:=8)myArray=(myRange)SettitleRange=(prompt:=請(qǐng)選擇拆分的表頭，必然是第一行，且為一個(gè)單元格，如：“姓名”,Type:=8)title=columnNum=False=FalseDimi&,Myr&,Arr,num&Dimd,kFori=To1Step-1IfSheets(i).Name數(shù)據(jù)源Then待拆分的表sheet名為：數(shù)據(jù)源Sheets(i).DeleteEndIfNextiSetd=CreateObje

4、ct()Myr=Worksheets(數(shù)據(jù)源).Cells(Myr,columnNum)Fori=1ToUBound(Arr)d(Arr(i,1)=Arr=Worksheets(數(shù)據(jù)源).Range(Cells(2,columnNum),Nextk=Fori=0ToUBound(k)Setconn=CreateObject()provider=properties=excel;datasource=&2013版連結(jié)字符Sql=select*from數(shù)據(jù)源$where&title&=&k(i)&DimNowbookAsWorkbookSetNowbook=WithNowbookWith.Shee

5、ts(1).Name=k(i)Fornum=1ToUBound(myArray).Cells(1,num)=myArray(num,1)Nextnum.Range(A2).CopyFromRecordset(Sql)EndWithEndWithSheets(1).Workbooks.ActivatePaste:=xlPasteFormats,Operation:=xlNone,_SkipBlanks:=False,Transpose:=FalseFalse&k(i)TrueSetNowbook=NothingNextiSetconn=NothingTrueTrueEndSub3、將含有多she

6、et的一個(gè)工作表，按sheet名拆分為工作表代碼以下：PrivateSub分拆工作表()DimshtAsWorksheetDimMyBookAsWorkbookSetMyBook=ActiveWorkbookForEachshtInFilename:=&,FileFormat:=xlNormal將工作簿另存為EXCEL默認(rèn)格式NextMsgBox文件已經(jīng)被分拆完成!EndSub4,、將多個(gè)工作薄歸并為一個(gè)多sheet的工作薄代碼以下：SubBooks2Sheets()定義對(duì)話框變量DimfdAsFileDialogSetfd=(msoFileDialogFilePicker)新建一個(gè)工作簿Di

7、mnewwbAsWorkbookSetnewwb=Withfd=-1Then定義單個(gè)文件變量DimvrtSelectedItemAsVariant定義循環(huán)量DimiAsIntegeri=1開(kāi)始文件檢索ForEachvrtSelectedItem翻開(kāi)被歸并工作簿DimtempwbAsWorkbookSettempwb=(vrtSelectedItem)復(fù)制工作表(1).CopyBefore:=(i)把新工作簿的工作表名字改成被復(fù)制工作簿文件名，這兒應(yīng)用于xls文件，Excel97-2003的文件，假如是Excel2007，需要改成xlsx(i).Name=,.xls,)封閉被歸并工作簿SaveChanges:=Falsei=i+1NextvrtSelectedItemEndIfEndWithSetfd=NothingEndSub5、將含有多個(gè)sheet的工作表內(nèi)容信息匯總至一個(gè)sheet中SubCombine()DimJAsIntegerOnErrorResumeNextSheets(1).SelectSheets(1).Name=CombinedSheets(2).ActivateRange(A1).Destination:=Sheets(1).Range(A1)F