工作表(Worksheet)相关的属性和基本操作应用示例

在编写代码时，经常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、删除工作表、复制工作表、移动工作表、重命名工作表，等等。 在编写代码时，经常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、删除工作表、复制工作表、移动工作表、重命名工作表，等等。下面介绍与此有关及相关的一些属性和方法示例。

--------------------------------------------------------------------------------

[示例04-01]增加工作表(Add方法)

Sub AddWorksheet()

  MsgBox "在当前工作簿中添加一个工作表"

  Worksheets.Add

  MsgBox "在当前工作簿中的工作表sheet2之前添加一个工作表"

  Worksheets.Add before:=Worksheets("sheet2")

  MsgBox "在当前工作簿中的工作表sheet2之后添加一个工作表"

  Worksheets.Add after:=Worksheets("sheet2")

  MsgBox "在当前工作簿中添加3个工作表"

  Worksheets.Add Count:=3

End Sub

示例说明：Add方法带有4个可选的参数，其中参数Before和参数After指定所增加的工作表的位置，但两个参数只能选一；参数Count用来指定增加的工作表数目。

--------------------------------------------------------------------------------

[示例04-02]复制工作表(Copy方法)

Sub CopyWorksheet()

  MsgBox "在当前工作簿中复制工作表sheet1并将所复制的工作表放在工作表sheet2之前"

  Worksheets("sheet1").Copy Before:=Worksheets("sheet2")

  MsgBox "在当前工作簿中复制工作表sheet2并将所复制的工作表放在工作表sheet3之后"

  Worksheets("sheet2").Copy After:=Worksheets("sheet3")

End Sub

示例说明：Copy方法带有2个可选的参数，即参数Before和参数After，在使用时两个参数只参选一。

--------------------------------------------------------------------------------

[示例04-03]移动工作表(Move方法)

Sub MoveWorksheet()

  MsgBox "在当前工作簿中将工作表sheet3移至工作表sheet2之前"

  Worksheets("sheet3").Move Before:=Worksheets("sheet2")

  MsgBox "在当前工作簿中将工作表sheet1移至最后"

  Worksheets("sheet1").Move After:=Worksheets(Worksheets.Count)

End Sub

示例说明：Move方法与Copy方法的参数相同，作用也一样。

--------------------------------------------------------------------------------

[示例04-04]隐藏和显示工作表(Visible属性)

[示例04-04-01]

Sub testHide()

  MsgBox "第一次隐藏工作表sheet1"

  Worksheets("sheet1").Visible = False

  MsgBox "显示工作表sheet1"

  Worksheets("sheet1").Visible = True

  MsgBox "第二次隐藏工作表sheet1"

  Worksheets("sheet1").Visible = xlSheetHidden

  MsgBox "显示工作表sheet1"

  Worksheets("sheet1").Visible = True

  MsgBox "第三次隐藏工作表sheet1"

  Worksheets("sheet1").Visible = xlSheetHidden

  MsgBox "显示工作表sheet1"

  Worksheets("sheet1").Visible = xlSheetVisible

  MsgBox "第四隐藏工作表sheet1"

  Worksheets("sheet1").Visible = xlSheetVeryHidden

  MsgBox "显示工作表sheet1"

  Worksheets("sheet1").Visible = True

  MsgBox "第五隐藏工作表sheet1"

  Worksheets("sheet1").Visible = xlSheetVeryHidden

  MsgBox "显示工作表sheet1"

  Worksheets("sheet1").Visible = xlSheetVisible

End Sub

示例说明：本示例演示了隐藏和显示工作表的各种情形。其中，使用xlSheetVeryHidden常量来隐藏工作表，将不能通过选择工作表菜单栏中的“格式”——“工作表”——“取消隐藏”命令来取消隐藏。

--------------------------------------------------------------------------------

[示例04-04-02]

Sub ShowAllSheets()

  MsgBox "使当前工作簿中的所有工作表都显示(即将隐藏的工作表也显示)"

  Dim ws As Worksheet

  For Each ws In Sheets

    ws.Visible = True

  Next ws

End Sub

--------------------------------------------------------------------------------

[示例04-05]获取工作表数(Count属性)

[示例04-05-01]

Sub WorksheetNum()

  Dim i As Long

  i = Worksheets.Count

  MsgBox "当前工作簿的工作表数为：" & Chr(10) & i

End Sub

--------------------------------------------------------------------------------

[示例04-05-02]

Sub WorksheetNum()

  Dim i As Long

  i = Sheets.Count

  MsgBox "当前工作簿的工作表数为：" & Chr(10) & i

End Sub

示例说明：在一个包含图表工作表的工作簿中运行上述两段代码，将会得出不同的结果，原因是对于Sheets集合来讲，工作表包含图表工作表。应注意Worksheets集合与Sheets集合的区别，下同。

--------------------------------------------------------------------------------

[示例04-06]获取或设置工作表名称(Name属性)

[示例04-06-01]

Sub NameWorksheet()

  Dim sName As String, sChangeName As String

  sName = Worksheets(2).Name

  MsgBox "当前工作簿中第2个工作表的名字为：" & sName

  sChangeName = "我的工作表"

  MsgBox "将当前工作簿中的第3个工作表名改为：" & sChangeName

  Worksheets(3).Name = sChangeName

End Sub

示例说明：使用Name属性可以获取指定工作表的名称，也可以设置工作表的名称。

Sub ReNameSheet()

   Dim xStr As String

Retry:

   Err.Clear

   xStr = InputBox("请输入工作表的新名称:" _

       , "重命名工作表", ActiveSheet.Name)

   If xStr = "" Then Exit Sub

   On Error Resume Next

   ActiveSheet.Name = xStr

   If Err.Number <> 0 Then

     MsgBox Err.Number & " " & Err.Description

     Err.Clear

     GoTo Retry

    End If

    On Error GoTo 0

    .........

 End Sub

--------------------------------------------------------------------------------

[NextPage][示例04-07]激活/选择工作表(Activate方法和Select方法)

[示例04-07-01]

Sub SelectWorksheet()

  MsgBox "激活当前工作簿中的工作表sheet2"

  Worksheets("sheet2").Activate

  MsgBox "激活当前工作簿中的工作表sheet3"

  Worksheets("sheet3").Select

  MsgBox "同时选择工作簿中的工作表sheet2和sheet3"

  Worksheets(Array("sheet2", "sheet3")).Select

End Sub

示例说明：Activate方法只能激活一个工作表，而Select方法可以同时选择多个工作表。

--------------------------------------------------------------------------------

[示例04-07-02]

Sub SelectManySheet()

  MsgBox "选取第一个和第三个工作表."

  Worksheets(1).Select

  Worksheets(3).Select False

End Sub

--------------------------------------------------------------------------------

[示例04-08]获取当前工作表的索引号(Index属性)

Sub GetSheetIndex()

  Dim i As Long

  i = ActiveSheet.Index

  MsgBox "您正使用的工作表索引号为" & i

End Sub

--------------------------------------------------------------------------------

[示例04-09]选取前一个工作表(Previous属性)

Sub PreviousSheet()

  If ActiveSheet.Index <> 1 Then

    MsgBox "选取当前工作簿中当前工作表的前一个工作表"

    ActiveSheet.Previous.Activate

  Else

    MsgBox "已到第一个工作表"

  End If

End Sub

示例说明：如果当前工作表是第一个工作表，则使用Previous属性会出错。

--------------------------------------------------------------------------------

[示例04-10]选取下一个工作表(Next属性)

Sub NextSheet()

  If ActiveSheet.Index <> Worksheets.Count Then

    MsgBox "选取当前工作簿中当前工作表的下一个工作表"

    ActiveSheet.Next.Activate

  Else

    MsgBox “已到最后一个工作表”

  End If

End Sub

示例说明：如果当前工作表是最后一个工作表，则使用Next属性会出错。

--------------------------------------------------------------------------------

[示例04-11]工作表行和列的操作

[示例04-11-01]隐藏行

Sub HideRow()

  Dim iRow As Long

  MsgBox "隐藏当前单元格所在的行"

  iRow = ActiveCell.Row

  ActiveSheet.Rows(iRow).Hidden = True

  MsgBox "取消隐藏"

  ActiveSheet.Rows(iRow).Hidden = False

End Sub

--------------------------------------------------------------------------------

[示例04-11-02]隐藏列

Sub HideColumn()

  Dim iColumn As Long

  MsgBox "隐藏当前单元格所在列"

  iColumn = ActiveCell.Column

  ActiveSheet.Columns(iColumn).Hidden = True

  MsgBox "取消隐藏"

  ActiveSheet.Columns(iColumn).Hidden = False

End Sub

--------------------------------------------------------------------------------

[示例04-11-03]插入行

Sub InsertRow()

  Dim rRow As Long

  MsgBox "在当前单元格上方插入一行"

  rRow = Selection.Row

  ActiveSheet.Rows(rRow).Insert

End Sub

--------------------------------------------------------------------------------

[示例04-11-04]插入列

Sub InsertColumn()

  Dim cColumn As Long

  MsgBox "在当前单元格所在行的左边插入一行"

  cColumn = Selection.Column

  ActiveSheet.Columns(cColumn).Insert

End Sub

--------------------------------------------------------------------------------

[示例04-11-05]插入多行

Sub InsertManyRow()

  MsgBox "在当前单元格所在行上方插入三行"

  Dim rRow As Long, i As Long

  For i = 1 To 3

    rRow = Selection.Row

    ActiveSheet.Rows(rRow).Insert

  Next i

End Sub

--------------------------------------------------------------------------------

[示例04-11-06]设置行高

Sub SetRowHeight()

  MsgBox "将当前单元格所在的行高设置为25"

  Dim rRow As Long, iRow As Long

  rRow = ActiveCell.Row

  iRow = ActiveSheet.Rows(rRow).RowHeight

  ActiveSheet.Rows(rRow).RowHeight = 25

  MsgBox "恢复到原来的行高"

  ActiveSheet.Rows(rRow).RowHeight = iRow

End Sub

--------------------------------------------------------------------------------

[示例04-11-07]设置列宽

Sub SetColumnWidth()

  MsgBox "将当前单元格所在列的列宽设置为20"

  Dim cColumn As Long, iColumn As Long

  cColumn = ActiveCell.Column

  iColumn = ActiveSheet.Columns(cColumn).ColumnWidth

  ActiveSheet.Columns(cColumn).ColumnWidth = 20

  MsgBox "恢复至原来的列宽"

  ActiveSheet.Columns(cColumn).ColumnWidth = iColumn

End Sub

--------------------------------------------------------------------------------

[示例04-11-08]恢复行高列宽至标准值

Sub ReSetRowHeightAndColumnWidth()

  MsgBox "将当前单元格所在的行高和列宽恢复为标准值"

  Selection.UseStandardHeight = True

  Selection.UseStandardWidth = True

End Sub

--------------------------------------------------------------------------------

[示例04-12]工作表标签

[示例04-12-01] 设置工作表标签的颜色

Sub SetSheetTabColor()

  MsgBox "设置当前工作表标签的颜色"

  ActiveSheet.Tab.ColorIndex = 7

End Sub

--------------------------------------------------------------------------------

[示例04-12-01]恢复工作表标签颜色

Sub SetSheetTabColorDefault()

  MsgBox "将当前工作表标签颜色设置为默认值"

  ActiveSheet.Tab.ColorIndex = -4142

End Sub

--------------------------------------------------------------------------------

[示例04-12-03]交替隐藏或显示工作表标签

Sub HideOrShowSheetTab()

  MsgBox "隐藏/显示工作表标签"

  ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs

End Sub

--------------------------------------------------------------------------------

[NextPage][示例04-13]确定打印的页数(HPageBreaks属性与VPageBreaks属性)

Sub PageCount()

  Dim i As Long

  i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)

  MsgBox "当前工作表共" & i & "页."

End Sub

--------------------------------------------------------------------------------

[示例04-14]保护/撤销保护工作表

[示例04-14-01]

Sub ProtectSheet()

  MsgBox "保护当前工作表并设定密码"

  ActiveSheet.Protect Password:="fanjy"

End Sub

示例说明：运行代码后，当前工作表中将不允许编辑，除非撤销工作表保护。

--------------------------------------------------------------------------------

[示例04-14-02]

Sub UnprotectSheet()

  MsgBox "撤销当前工作表保护"

  ActiveSheet.Unprotect

End Sub

示例说明：运行代码后，如果原保护的工作表设置有密码，则要求输入密码。

--------------------------------------------------------------------------------

[示例04-14-03]保护当前工作簿中的所有工作表

Sub ProtectAllWorkSheets()

  On Error Resume Next

  Dim ws As Worksheet

  Dim myPassword As String

  myPassword = InputBox("请输入您的密码" & vbCrLf & _

   "(不输入表明无密码)" & vbCrLf & vbCrLf & _

   "确保您没有忘记密码！", "输入密码")

  For Each ws In ThisWorkbook.Worksheets

    ws.Protect (myPassword)

  Next ws

End Sub

--------------------------------------------------------------------------------

[示例04-14-04]撤销对当前工作簿中所有工作表的保护

Sub UnprotectAllWorkSheets()

  On Error Resume Next

  Dim ws As Worksheet

  Dim myPassword As String

  myPassword = InputBox("请输入您的密码" & vbCrLf & _

    "(不输入表示无密码)", "输入密码")

  For Each ws In ThisWorkbook.Worksheets

    ws.Unprotect (myPassword)

  Next ws

End Sub

--------------------------------------------------------------------------------

[示例04-14-05]仅能编辑未锁定的单元格

Sub OnlyEditUnlockedCells()

  Sheets("Sheet1").EnableSelection = xlUnlockedCells

  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

示例说明：运行本代码后，在当前工作表中将只能对未锁定的单元格进行编辑，而其它单元格将不能编辑。未锁定的单元格是指在选择菜单“格式——单元格”命令后所弹出的对话框中的“保护”选项卡中，未选中“锁定”复选框的单元格或单元格区域。

--------------------------------------------------------------------------------

[示例04-15]删除工作表(Delete方法)

Sub DeleteWorksheet()

  MsgBox "删除当前工作簿中的工作表sheet2"

  Application.DisplayAlerts = False

  Worksheets("sheet2").Delete

  Application.DisplayAlerts = True

End Sub

示例说明：本示例代码使用Application.DisplayAlerts = False来屏蔽弹出的警告框。

--------------------------------------------------------------------------------

<一些编程方法和技巧>

[示例04-16] 判断一个工作表(名)是否存在

[示例04-16-01]

Sub testWorksheetExists1()

  Dim ws As Worksheet

  If Not WorksheetExists(ThisWorkbook, "sheet1") Then

    MsgBox "不能够找到该工作表", vbOKOnly

    Exit Sub

  End If

  MsgBox "已经找到工作表"

  Set ws = ThisWorkbook.Worksheets("sheet1")

End Sub

- - - - - - - - - - - - - - - - - - -

Function WorksheetExists(wb As Workbook, sName As String) As Boolean

  Dim s As String

  On Error GoTo ErrHandle

  s = wb.Worksheets(sName).Name

  WorksheetExists = True

  Exit Function

ErrHandle:

  WorksheetExists = False

  End Function

示例说明：在测试代码中，用相应的工作簿名和工作表名分别代替“ThisWorkbook”和“Sheet1”，来判断指定工作表是否在工作簿中存在。

--------------------------------------------------------------------------------

[示例04-16-02]

Sub testWorksheetExists2()

  If Not SheetExists("<工作表名>") Then

    MsgBox "<工作表名> 不存在!"

  Else

    Sheets("<工作表名>").Activate

  End If

End Sub

- - - - - - - - - - - - - - - - - - -

Function SheetExists(SheetName As String) As Boolean

  SheetExists = False

  On Error GoTo NoSuchSheet

  If Len(Sheets(SheetName).Name) > 0 Then

    SheetExists = True

    Exit Function

  End If

NoSuchSheet:

End Function

示例说明：在代码中，用实际工作表名代替<>。

--------------------------------------------------------------------------------

[示例04-16-03]

Sub TestingFunction()

 如果工作表存在则返回True，否则为False

  测试DoesWksExist1函数

  Debug.Print DoesWksExist1("Sheet1")

  Debug.Print DoesWksExist1("Sheet100")

  Debug.Print "-----"

  测试DoesWksExist2函数

  Debug.Print DoesWksExist2("Sheet1")

  Debug.Print DoesWksExist2("Sheet100")

End Sub

‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Function DoesWksExist1(sWksName As String) As Boolean

  Dim i As Long

  For i = Worksheets.Count To 1 Step -1

    If Sheets(i).Name = sWksName Then

      Exit For

    End If

  Next

  If i = 0 Then

    DoesWksExist1 = False

  Else

    DoesWksExist1 = True

  End If

End Function

‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Function DoesWksExist2(sWksName As String) As Boolean

  Dim wkb As Worksheet

  On Error Resume Next

  Set wkb = Sheets(sWksName)

  On Error GoTo 0

  DoesWksExist2 = IIf(Not wkb Is Nothing, True, False)

End Function

--------------------------------------------------------------------------------

[示例04-17]排序工作表

[示例04-17-01]

Sub SortWorksheets1()

  Dim bSorted As Boolean

  Dim nSortedSheets As Long

  Dim nSheets As Long

  Dim n As Long

  nSheets = Worksheets.Count

  nSortedSheets = 0

  Do While (nSortedSheets < nSheets) And Not bSorted

    bSorted = True

    nSortedSheets = nSortedSheets + 1

    For n = 1 To nSheets - nSortedSheets

      If StrComp(Worksheets(n).Name, Worksheets(n + 1).Name, vbTextCompare) > 0 Then

        Worksheets(n + 1).Move Before:=Worksheets(n)

        bSorted = False

      End If

    Next n

   Loop

End Sub

示例说明：本示例代码采用了冒泡法排序。

--------------------------------------------------------------------------------

[示例04-17-02]

Sub SortWorksheets2()

  根据字母对工作表排序

  Dim i As Long, j As Long

  For i = 1 To Sheets.Count

    For j = 1 To Sheets.Count - 1

      If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then

        Sheets(j).Move After:=Sheets(j + 1)

      End If

    Next j

  Next i

End Sub

--------------------------------------------------------------------------------

[示例04-17-03]

Sub SortWorksheets3()

 以升序排列工作表

  Dim sCount As Integer, i As Integer, j As Integer

  Application.ScreenUpdating = False

  sCount = Worksheets.Count

  If sCount = 1 Then Exit Sub

  For i = 1 To sCount - 1

    For j = i + 1 To sCount

      If Worksheets(j).Name < Worksheets(i).Name Then

        Worksheets(j).Move Before:=Worksheets(i)

      End If

    Next j

  Next i

End Sub

示例说明：若想排序所有工作表，将代码中的Worksheets替换为Sheets。

--------------------------------------------------------------------------------

[示例04-18]删除当前工作簿中的空工作表

Sub Delete_EmptySheets()

    Dim sh As Worksheet

    For Each sh In ThisWorkbook.Worksheets

      If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then

      Application.DisplayAlerts = False

        sh.Delete

        Application.DisplayAlerts = True

      End If

    Next

End Sub