第2章--Sheet(工作表)对象代码【超实用VBA】

15第2章Sheet（工作表）对象范例18引用工作表的方法18-1使用工作表名称SubShtName()Worksheets(Sheet2).Range(A1)=Excel2007EndSub18-2使用工作表索引号SubShtIndex()Worksheets(Worksheets.Count).SelectEndSub18-3使用工作表代码名称SubShtCodeName()Sheet3.SelectEndSub范例19选择工作表的方法SubShtSelect()MsgBox下面将选择&Sheet2.Name&工作表Sheet2.SelectMsgBox下面将激活&Sheet3.Name&工作表Sheet3.ActivateEndSubSubSelectSht()DimShtAsWorksheetForEachShtInWorksheets16Sht.SelectFalseNextEndSubSubSelectSheets()Worksheets.SelectEndSubSubArraySheets()Worksheets(Array(1,3)).SelectEndSub范例20遍历工作表的方法20-1使用For...Next语句SubTraversalShtOne()DimiAsIntegerDimStrAsStringFori=1ToWorksheets.CountStr=Str&Worksheets(i).Name&vbCrLfNextMsgBox工作簿中含有以下工作表：&vbCrLf&StrEndSub20-1使用ForEach...Next语句SubTraversalShtTwo()DimShtAsWorksheetDimStrAsStringForEachShtInWorksheetsStr=Str&Sht.Name&vbCrLfNextMsgBox工作簿中含有以下工作表：&vbCrLf&StrEndSub范例21工作表的添加与删除SubShtAddOne()Worksheets.Add.Name=数据EndSub17SubShtAddTwo()DimiAsIntegerDimShtAsWorksheetWithWorksheetsFori=1To6SetSht=.Add(after:=Worksheets(.Count))Sht.Name=iNextEndWithSetSht=NothingEndSubSubShtDel()DimShtAsWorksheetApplication.DisplayAlerts=FalseForEachShtInWorksheetsIfSht.Name工作表的添加与删除ThenSht.DeleteEndIfNextApplication.DisplayAlerts=TrueSetSht=NothingEndSubSubShtAddThree()DimShtAsWorksheetForEachShtInWorksheetsIfSht.Name=数据ThenIfMsgBox(工作簿中已有数据工作表,是否删除后添加?,36)=6ThenApplication.DisplayAlerts=FalseSht.DeleteApplication.DisplayAlerts=TrueElseExitSubEndIfEndIfNextWorksheets.Add.Name=数据SetSht=NothingEndSubSubShtAddFour()DimarrAsVariantDimiAsInteger18DimShtAsWorksheetOnErrorResumeNextarr=Array(1,2,3,4,5,6)WithWorksheetsFori=0ToUBound(arr)SetSht=.Add(after:=Worksheets(.Count))Sht.Name=arr(i)NextEndWithApplication.DisplayAlerts=FalseForEachShtInWorksheetsIfSht.NameLikeSheet*ThenSht.DeleteNextApplication.DisplayAlerts=TrueSetSht=NothingEndSub范例22禁止删除指定工作表PrivateSubWorkbook_Activate()Application.CommandBars.FindControl(ID:=847).OnAction=MyDelShtEndSubSubMyDelSht()IfActiveSheet.CodeName=Sheet2ThenMsgBoxActiveSheet.Name&工作表禁止删除!,48ElseActiveSheet.DeleteEndIfEndSubPrivateSubWorkbook_Deactivate()Application.CommandBars.FindControl(ID:=847).OnAction=EndSub范例23禁止更改工作表名称PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)IfSheet1.NameImportantThenSheet1.Name=ImportantThisWorkbook.SaveEndSub19范例24判断是否存在指定工作表SubShtExists()DimShtAsWorksheetOnErrorGoTolineSetSht=Worksheets(abc)MsgBox工作簿中已有abc工作表!ExitSubline:MsgBox工作簿中没有abc工作表!EndSub范例25工作表的深度隐藏PublicshtAsWorksheetPrivateSubWorkbook_BeforeClose(CancelAsBoolean)Sheet1.Visible=TrueForEachshtInThisWorkbook.SheetsIfsht.CodeNameSheet1Thensht.Visible=xlSheetVeryHiddenEndIfNextThisWorkbook.SaveEndSubPrivateSubWorkbook_Open()ForEachshtInThisWorkbook.SheetsIfsht.CodeNameSheet1Thensht.Visible=xlSheetVisibleEndIfNextSheet1.Visible=xlSheetVeryHiddenEndSub范例26工作表的保护与取消保护在SubShProtect()WithSheet1.UnprotectPassword:=123.Cells(1,1)=.Cells(1,1)+10020.ProtectPassword:=123EndWithEndSubSubRemoveShProtect()Dimi1AsInteger,i2AsInteger,i3AsIntegerDimi4AsInteger,i5AsInteger,i6AsIntegerDimi7AsInteger,i8AsInteger,i9AsIntegerDimi10AsInteger,i11AsInteger,i12AsIntegerDimtAsStringOnErrorResumeNextIfActiveSheet.ProtectContents=FalseThenMsgBox该工作表没有保护密码!ExitSubEndIft=TimerFori1=65To66:Fori2=65To66:Fori3=65To66Fori4=65To66:Fori5=65To66:Fori6=65To66Fori7=65To66:Fori8=65To66:Fori9=65To66Fori10=65To66:Fori11=65To66:Fori12=32To126ActiveSheet.UnprotectChr(i1)&Chr(i2)&Chr(i3)&Chr(i4)&Chr(i5)_&Chr(i6)&Chr(i7)&Chr(i8)&Chr(i9)&Chr(i10)&Chr(i11)&Chr(i12)IfActiveSheet.ProtectContents=FalseThenMsgBox解除工作表保护!用时&Format(Timer-t,0.00)&秒ExitSubEndIfNext:Next:Next:Next:Next:NextNext:Next:Next:Next:Next:NextEndSub范例27自动建立工作表目录PrivateSubWorksheet_Activate()DimShtAsWorksheetDimaAsIntegerDimrAsIntegerr=Cells(Rows.Count,1).End(xlUp).Rowa=2Ifr1ThenRange(A2:A&r).ClearContentsForEachShtInWorksheetsIfSht.CodeNameSheet1ThenCells(a,1).Value=Sht.Namea=a+1EndIf21NextSetSht=NothingEndSubPrivateSubWorksheet_SelectionChange(ByValTargetAsRange)DimrAsIntegerr=Cells(Rows.Count,1).End(xlUp).RowOnErrorResumeNextIfNotApplication.Intersect(Target,Range(A2:A&r))IsNothingThenSheets(Target.Text).SelectEndIfEndSub范例28循环选择工作表如果需要循环选择工作簿中的工作表，可以使用Worksheet对象的Next属性和Previous属性，范例代码如下：SubShtNext()IfActiveSheet.IndexWorksheets.CountThenActiveSheet.Next.ActivateElseWorksheets(1).ActivateEndIfEndSubSubShtPrevious()IfActiveSheet.Index1ThenActiveSheet.Previous.ActivateElseWorksheets(Worksheets.Count).ActivateEndIfEndSub范例29工作表中一次插入多行SubInSertRow()DimiAsIntegerFori=1To3Sheet1.Rows(3).InsertNextEndSub22范例30删除工作表中的空行SubDelBlankRow()DimrAsLongDimiAsLongr=Sheet1.UsedRange.Rows.CountFori=rTo1Step-1IfRows(i).Find(*,,xlValues,,,2)IsNothingThenRows(i).DeleteEndIfNextEndSub范例31删除工作表的重复行SubDeleteRow()DimrAsIntegerDimiAsIntegerWithSheet1r=.Cells(.Rows.Count,1).End(xlUp).RowFori=rTo1Step-1IfWorksheetFunction.CountIf(.Columns(1),.Cells(i,1))1Then.Rows(i).DeleteEndIfNextEndWithEndSub范例32定位删除特定内容所在的行SubSpecialDelete()DimrAsLongWithSheet1r=.Cells(.Rows.Count,1).End(xlUp).Row.Range(A2:A&r).ReplaceVT248PA,,2.Columns(1).Sp