Excel2007VBA数组和工作表及单元格的引用动态数组使用：声明数组

81 阅读 0 评论 54 点赞

我是靠谱客的博主完美乐曲，这篇文章主要介绍Excel2007VBA数组和工作表及单元格的引用动态数组使用：声明数组，现在分享给大家，希望可以做个参考。

动态数组使用：

https://zhidao.baidu.com/question/1432222709706721499.html

使用Redim动态数组即可。

 
       Sub  
       test1() 
      
       Dim  
       a()  
       As  
       Integer 
       , iRow  
       As  
       Long 
       , i  
       As  
       Integer 
      
       iRow = Cells(Rows.Count, 1). 
       End 
       (xlUp).Row 
      
       ReDim  
       a(iRow - 1) 
      
       For  
       i = 1  
       To  
       UBound(a) 
      
       a(i - 1) = Range( 
       "A"  
       & i) 
      
       Next 
      
       End  
       Sub

声明数组

请参阅特性

数组的声明方式和其它的变量是一样的，它可以使用 Dim、Static、Private 或 Public 语句来声明。标量变量（非数组）与数组变量的不同在于通常必须指定数组的大小。若数组的大小被指定的话，则它是个固定大小数组。若程序运行时数组的大小可以被改变，则它是个动态数组。

数组是否从 0 或 1 索引是根据 Option Base 语句的设置。如果 Option Base 没有指定为 1，则数组索引从零开始。

声明固定大小的数组

下面这行代码声明了一个固定大小的数组，它是个 11 行乘以 11 列的 Integer 数组：

复制代码

1
2
Dim MyArray(10, 10) As Integer

第一个参数代表的是行；而第二个参数代表的是列。

与其它变量的声明一样，除非指定一个数据类型给数组，否则声明数组中元素的数据类型为 Variant。数组中每个数组的数字型 Variant 元素占用 16 个字节。每个字符串型 Variant 元素占用 22 个字节。为了尽可能使写的代码简洁明了，则要明确声明的数组为某一种数据类型而非 Variant。下面的这几行代码比较了几个不同数组的大小：

复制代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
' 整型数组使用 22 个字节（11 元素* 2 字节）
ReDim MyIntegerArray(10) As Integer

' 双精度数组使用 88 个字节（11 元素 * 8 字节）。
ReDim MyDoubleArray(10) As Double

' 变体型数组至少使用 176 字节（11 元素 * 16 字节）。
ReDim MyVariantArray(10)

' 整型数组使用 100 * 100 * 2 字节（20,000 字节）。
ReDim MyIntegerArray (99, 99) As Integer 

' 双精度数组使用 100 * 100 * 8 字节（80,000 字节）。
ReDim MyDoubleArray (99, 99) As Double 

' 变体型数组至少使用 160,000 字节（100 * 100 * 16 字节）。
ReDim MyVariantArray(99, 99)

数组变量的最大值，是以的操作系统与有多少可用内存为基础。若使用的数组大小超过了系统中可用内存总数的话，则速度会变慢，因为必须从磁盘中读写回数据。

声明动态数组

若声明为动态数组，则可以在执行代码时去改变数组大小。可以利用 Static、Dim、Private 或 Public 语句来声明数组，并使括号内为为空，如下示例所示。

复制代码

1
2
Dim sngArray() As Single

注意可以在过程中使用 ReDim 语句来做隐含性的数组声明。当使用 ReDim 语句时要小心点，不要拼错数组的名称。否则即使在模块中有包含 Option Explicit 语句，仍然会因此而生成第二个数组。

对于过程中的数组范围，可以使用 ReDim 语句去改变它的维数，去定义元素的数目以及每个维数的底层绑定。每当需要时，可以使用 ReDim 语句去更改动态数组。然而当做这个动作时，数组中存在的值会丢失。若要保存数组中原先的值，则可以使用 ReDim Preserve 语句来扩充数组。例如，下列的语句将 varArray 数组扩充了10 个元素，而原本数组中的当前值并没有消失掉。

复制代码

1
2
ReDim Preserve varArray(UBound(varArray) + 10)

注意当对动态数组使用 Preserve 关键字时，只可以改变最后维数的上层绑定，而不能改变维数的数目。

新建工作簿：

复制代码

1
2
3
4
5
6
7
8
1 Sub AddNew()
2 Set NewBook = Workbooks.Add
3     With NewBook
4         .Title = "All Sales"
5         .Subject = "Sales"
6         .SaveAs Filename:="Allsales.xls"
7     End With
8 End Sub

可用 Array 函数标识一组工作表。以下示例选定了活动工作簿中的三张工作表。

复制代码

1
2
3
1 Sub Several()
2     Worksheets(Array("Sheet1", "Sheet2", "Sheet4")).Select
3 End Sub

操作方法：通过索引号引用工作表

索引号是分配给工作表的连续数字，基于其工作表标签在同一类型的工作表之间的位置（按从左到右计数）。下面的过程使用 Worksheets 属性激活活动工作簿上的第一张工作表。

复制代码

1
2
3
Sub FirstOne()
    Worksheets(1).Activate
End Sub

如果要处理所有类型的工作表（工作表、图表、模块和对话框编辑表），可使用 Sheets 属性。以下过程激活工作簿中的第四张工作表。

复制代码

1
2
3
Sub FourthOne()
    Sheets(4).Activate
End Sub

注释
如果移动、添加或删除工作表，索引顺序可能会发生变化。

操作方法：通过名称引用工作表

使用 Worksheets 属性和 Charts 属性可通过名称来标识工作表。下述语句激活活动工作簿中的不同工作表。

复制代码

1
2
Worksheets("Sheet1").Activate
Charts("Chart1").Activate

复制代码

1
DialogSheets("Dialog1").Activate

使用 Sheets 属性可以返回工作表、图表、模块或对话框编辑表；Sheets 集合包含所有这些内容。本示例将激活活动工作簿中的名为“Chart1”的工作表。

复制代码

1
2
3
Sub ActivateChart()
    Sheets("Chart1").Activate
End Sub

注释
嵌入到工作表中的图表是 ChartObjects 集合的成员，而那些位于单独的工作表上的图表则属于 Charts 集合。

打开工作簿

用 Open 方法打开一个工作簿时，该工作簿将成为 Workbooks 集合的成员。下述过程打开 C 盘上名为 MyFolder 的文件夹中的 MyBook.xls 工作簿。

复制代码

1
2
3
Sub OpenUp()
    Workbooks.Open("C:MyFolderMyBook.xls")
End Sub

操作方法：引用工作表上的所有单元格

如果对工作表应用 Cells 属性时不指定索引号，该方法将返回代表工作表上所有单元格的 Range 对象。以下 Sub 过程清除活动工作簿中 Sheet1 上的所有单元格的内容。

复制代码

1
2
3
Sub ClearSheet()
    Worksheets("Sheet1").Cells.ClearContents
End Sub

操作方法：使用 A1 表示法引用单元格和区域

可使用 Range 属性引用 A1 引用样式中的单元格或单元格区域。下述子例程将单元格区域 A1:D5 的字体设置为加粗。

复制代码

1
2
3
4
Sub FormatRange()
    Workbooks("Book1").Sheets("Sheet1").Range("A1:D5") _
        .Font.Bold = True
End Sub

下表演示了使用 Range 属性的一些 A1 样式引用。

引用	含义
`Range("A1")`	单元格 A1
`Range("A1:B5")`	从单元格 A1 到单元格 B5 的区域
`Range("C5:D9,G9:H16")`	多块选定区域
`Range("A:A")`	A 列
`Range("1:1")`	第一行
`Range("A:C")`	从 A 列到 C 列的区域
`Range("1:5")`	从第一行到第五行的区域
`Range("1:1,3:3,8:8")`	第 1、3 和 8 行
`Range("A:A,C:C,F:F")`	A 、C 和 F 列

操作方法：使用 Range 对象引用单元格

如果将对象变量设置为 Range 对象，即可用变量名轻松地操作单元格区域。

以下过程将创建对象变量 myRange，然后将活动工作簿中 Sheet1 上的区域 A1:D5 赋予该变量。随后的语句用该变量名称代替 Range 对象，以修改该区域的属性。

复制代码

1
2
3
4
5
6
Sub Random()
    Dim myRange As Range
    Set myRange = Worksheets("Sheet1").Range("A1:D5")
    myRange.Formula = "=RAND()"
    myRange.Font.Bold = True
End Sub

操作方法：使用索引号引用单元格

通过使用行列索引号，可用 Cells 属性引用单个单元格。该属性返回代表单个单元格的 Range 对象。在下例中，Cells(6,1) 返回 Sheet1 上的单元格 A6，然后将 Value 属性设置为 10。

复制代码

1
2
3
Sub EnterValue()
    Worksheets("Sheet1").Cells(6, 1).Value = 10
End Sub

因为可用变量替代编号，所以 Cells 属性非常适合于在单元格区域中循环，如下例中所示。

复制代码

1
2
3
4
5
6
Sub CycleThrough()
    Dim Counter As Integer
    For Counter = 1 To 20
        Worksheets("Sheet1").Cells(Counter, 3).Value = Counter
    Next Counter
End Sub

注释
如果要同时更改某个区域中所有单元格的属性（或将方法应用于该区域中的所有单元格），请使用 Range 属性。有关详细信息，请参阅使用 A1 表示法引用单元格和区域。

操作方法：使用快捷表示法引用单元格

可用方括号将 A1 引用样式或命名区域括起来，作为 Range 属性的快捷方式。这样就不必键入单词“Range”或使用引号了，如下例中所示。

复制代码

1
2
3
4
5
6
7
Sub ClearRange()
    Worksheets("Sheet1").[A1:B5].ClearContents
End Sub

Sub SetValue()
    [MyRange].Value = 30
End Sub

Excel VBA教程：相对于其他单元格来引用单元格

处理相对于另一个单元格的某一单元格的常用方法是使用Offset属性。下例中，将位于活动工作表上活动单元格下一行和右边三列的单元格的内容设置为双下划线格式。

复制代码

1
2
3
4
5

Sub Underline()
    ActiveCell.Offset(1, 3).Font.Underline = xlDouble
End Sub

注意可录制使用 Offset属性（而不是绝对引用）的宏。在“工具”菜单上，指向“宏”，再单击“录制新宏”，然后单击“确定”，再单击录制宏工具栏上的“相对引用”按钮。

若要在单元格区域中循环，请在循环中将变量与 Cells属性一起使用。下例以 5 为步长，用 5 到 100 之间的值填充第三列的前 20 个单元格。变量counter 用作 Cells属性的行号。

复制代码

1
2
3
4
5
6
7

Sub CycleThrough()
    Dim counter As Integer
    For counter = 1 To 20
        Worksheets("Sheet1").Cells(counter, 3).Value = counter * 5
    Next counter
End Sub
如下图：

代码如下：

复制代码

1
2
3
4
5
6
7
8
1 Sub Random()
2     Dim myRange As Range
3     Set myRange = Worksheets("Sheet1").Range("A1:D5")
4     myRange.Formula = "=RAND()"
5     myRange.Font.Bold = True
6     Cells(4, 4).Select
7     ActiveCell.Offset(-1, -3).Font.Underline = xlDouble
8 End Sub

操作方法：引用多个区域

使用适当的方法可以很容易地同时引用多个单元格区域。可用 Range 和 Union 方法引用任意组合的单元格区域；用 Areas 属性可引用工作表上选定的一组单元格区域。

使用 Range 属性

通过在两个或多个引用之间插入逗号，可使用 Range 属性引用多个区域。以下示例清除了 Sheet1 上三个区域的内容。

复制代码

1
2
3
4
Sub ClearRanges()
    Worksheets("Sheet1").Range("C5:D9,G9:H16,B14:D18"). _
        ClearContents
End Sub

命名区域使得用 Range 属性处理多个区域更加容易。以下示例可在所有这三个命名区域处于同一工作表时运行。

复制代码

1
2
3
Sub ClearNamed()
    Range("MyRange, YourRange, HisRange").ClearContents
End Sub

使用 Union 方法

使用 Union 方法可将多个区域组合到一个 Range 对象中。以下示例创建了名为 myMultipleRange 的 Range 对象，并将其定义为区域 A1:B2 和 C3:D4 的组合，然后将该组合区域的字体设置为加粗。

复制代码

1
2
3
4
5
6
7
Sub MultipleRange()
    Dim r1, r2, myMultipleRange As Range
    Set r1 = Sheets("Sheet1").Range("A1:B2")
    Set r2 = Sheets("Sheet1").Range("C3:D4")
    Set myMultipleRange = Union(r1, r2)
    myMultipleRange.Font.Bold = True
End Sub

使用 Areas 属性

可用 Areas 属性引用选定的单元格区域或多块选定区域中的区域集合。下述过程计算选定区域中的块数目，如果有多个块，就显示一则警告消息。

复制代码

1
2
3
4
5
Sub FindMultiple()
    If Selection.Areas.Count > 1 Then
        MsgBox "Cannot do this to a multiple selection."
    End If
End Sub

复制代码

1 工作表(Worksheet)基本操作应用示例
  2 作者：fanjy | 来源：ExcelHomeBlog | 时间：2006-12-21 | 阅读权限：游客 | 会员币：0 | 【大 中 小】
  3 在编写代码时，经常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、删除工作表、复制工作表、移动工作表、重命名工作表，等等。下面介绍与此有关及相关的一些属性和方法示例。
  4 [示例04-01]增加工作表(Add方法)
  5 Sub AddWorksheet()
  6   MsgBox "在当前工作簿中添加一个工作表"
  7   Worksheets.Add
  8   MsgBox "在当前工作簿中的工作表sheet2之前添加一个工作表"
  9   Worksheets.Add before:=Worksheets("sheet2")
 10   MsgBox "在当前工作簿中的工作表sheet2之后添加一个工作表"
 11   Worksheets.Add after:=Worksheets("sheet2")
 12   MsgBox "在当前工作簿中添加3个工作表"
 13   Worksheets.Add Count:=3
 14 End Sub
 15 示例说明：Add方法带有4个可选的参数，其中参数Before和参数After指定所增加的工作表的位置，但两个参数只能选一；参数Count用来指定增加的工作表数目。
 16 [示例04-02]复制工作表(Copy方法)
 17 Sub CopyWorksheet()
 18   MsgBox "在当前工作簿中复制工作表sheet1并将所复制的工作表放在工作表sheet2之前"
 19   Worksheets("sheet1").Copy Before:=Worksheets("sheet2")
 20   MsgBox "在当前工作簿中复制工作表sheet2并将所复制的工作表放在工作表sheet3之后"
 21   Worksheets("sheet2").Copy After:=Worksheets("sheet3")
 22 End Sub
 23 示例说明：Copy方法带有2个可选的参数，即参数Before和参数After，在使用时两个参数只参选一。
 24 [示例04-03]移动工作表(Move方法)
 25 Sub MoveWorksheet()
 26   MsgBox "在当前工作簿中将工作表sheet3移至工作表sheet2之前"
 27   Worksheets("sheet3").Move Before:=Worksheets("sheet2")
 28   MsgBox "在当前工作簿中将工作表sheet1移至最后"
 29   Worksheets("sheet1").Move After:=Worksheets(Worksheets.Count)
 30 End Sub
 31 示例说明：Move方法与Copy方法的参数相同，作用也一样。
 32 [示例04-04]隐藏和显示工作表(Visible属性)
 33 [示例04-04-01]
 34 Sub testHide()
 35   MsgBox "第一次隐藏工作表sheet1"
 36   Worksheets("sheet1").Visible = False
 37   MsgBox "显示工作表sheet1"
 38   Worksheets("sheet1").Visible = True
 39   MsgBox "第二次隐藏工作表sheet1"
 40   Worksheets("sheet1").Visible = xlSheetHidden
 41   MsgBox "显示工作表sheet1"
 42   Worksheets("sheet1").Visible = True
 43   MsgBox "第三次隐藏工作表sheet1"
 44   Worksheets("sheet1").Visible = xlSheetHidden
 45   MsgBox "显示工作表sheet1"
 46   Worksheets("sheet1").Visible = xlSheetVisible
 47   MsgBox "第四隐藏工作表sheet1"
 48   Worksheets("sheet1").Visible = xlSheetVeryHidden
 49   MsgBox "显示工作表sheet1"
 50   Worksheets("sheet1").Visible = True
 51   MsgBox "第五隐藏工作表sheet1"
 52   Worksheets("sheet1").Visible = xlSheetVeryHidden
 53   MsgBox "显示工作表sheet1"
 54   Worksheets("sheet1").Visible = xlSheetVisible
 55 End Sub
 56 示例说明：本示例演示了隐藏和显示工作表的各种情形。其中，使用xlSheetVeryHidden常量来隐藏工作表，将不能通过选择工作表菜单栏中的“格式”——“工作表”——“取消隐藏”命令来取消隐藏。
 57 [示例04-04-02]
 58 Sub ShowAllSheets()
 59   MsgBox "使当前工作簿中的所有工作表都显示(即将隐藏的工作表也显示)"
 60   Dim ws As Worksheet
 61   For Each ws In Sheets
 62     ws.Visible = True
 63   Next ws
 64 End Sub
 65 [示例04-05]获取工作表数(Count属性)
 66 [示例04-05-01]
 67 Sub WorksheetNum()
 68   Dim i As Long
 69   i = Worksheets.Count
 70   MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
 71 End Sub
 72 [示例04-05-02]
 73 Sub WorksheetNum()
 74   Dim i As Long
 75   i = Sheets.Count
 76   MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
 77 End Sub
 78 示例说明：在一个包含图表工作表的工作簿中运行上述两段代码，将会得出不同的结果，原因是对于Sheets集合来讲，工作表包含图表工作表。应注意Worksheets集合与Sheets集合的区别，下同。
 79 [示例04-06]获取或设置工作表名称(Name属性)
 80 [示例04-06-01]
 81 Sub NameWorksheet()
 82   Dim sName As String, sChangeName As String
 83   sName = Worksheets(2).Name
 84   MsgBox "当前工作簿中第2个工作表的名字为：" & sName
 85   sChangeName = "我的工作表"
 86   MsgBox "将当前工作簿中的第3个工作表名改为：" & sChangeName
 87   Worksheets(3).Name = sChangeName
 88 End Sub
 89 示例说明：使用Name属性可以获取指定工作表的名称，也可以设置工作表的名称。
 90 [示例04-06-02]重命名工作表
 91 Sub ReNameSheet()
 92    Dim xStr As String
 93 Retry:
 94    Err.Clear
 95    xStr = InputBox("请输入工作表的新名称:" _
 96        , "重命名工作表", ActiveSheet.Name)
 97    If xStr = "" Then Exit Sub
 98    On Error Resume Next
 99    ActiveSheet.Name = xStr
100    If Err.Number <> 0 Then
101      MsgBox Err.Number & " " & Err.Description
102      Err.Clear
103      GoTo Retry
104     End If
105     On Error GoTo 0
106     '.........
107  End Sub
108 [NextPage][示例04-07]激活/选择工作表(Activate方法和Select方法)
109 [示例04-07-01]
110 Sub SelectWorksheet()
111   MsgBox "激活当前工作簿中的工作表sheet2"
112   Worksheets("sheet2").Activate
113   MsgBox "激活当前工作簿中的工作表sheet3"
114   Worksheets("sheet3").Select
115   MsgBox "同时选择工作簿中的工作表sheet2和sheet3"
116   Worksheets(Array("sheet2", "sheet3")).Select
117 End Sub
118 示例说明：Activate方法只能激活一个工作表，而Select方法可以同时选择多个工作表。
119 [示例04-07-02]
120 Sub SelectManySheet()
121   MsgBox "选取第一个和第三个工作表."
122   Worksheets(1).Select
123   Worksheets(3).Select False
124 End Sub
125 [示例04-08]获取当前工作表的索引号(Index属性)
126 Sub GetSheetIndex()
127   Dim i As Long
128   i = ActiveSheet.Index
129   MsgBox "您正使用的工作表索引号为" & i
130 End Sub
131 [示例04-09]选取前一个工作表(Previous属性)
132 Sub PreviousSheet()
133   If ActiveSheet.Index <> 1 Then
134     MsgBox "选取当前工作簿中当前工作表的前一个工作表"
135     ActiveSheet.Previous.Activate
136   Else
137     MsgBox "已到第一个工作表"
138   End If
139 End Sub
140 示例说明：如果当前工作表是第一个工作表，则使用Previous属性会出错。
141 [示例04-10]选取下一个工作表(Next属性)
142 Sub NextSheet()
143   If ActiveSheet.Index <> Worksheets.Count Then
144     MsgBox "选取当前工作簿中当前工作表的下一个工作表"
145     ActiveSheet.Next.Activate
146   Else
147     MsgBox “已到最后一个工作表”
148   End If
149 End Sub
150 示例说明：如果当前工作表是最后一个工作表，则使用Next属性会出错。
151 [示例04-11]工作表行和列的操作
152 [示例04-11-01]隐藏行
153 Sub HideRow()
154   Dim iRow As Long
155   MsgBox "隐藏当前单元格所在的行"
156   iRow = ActiveCell.Row
157   ActiveSheet.Rows(iRow).Hidden = True
158   MsgBox "取消隐藏"
159   ActiveSheet.Rows(iRow).Hidden = False
160 End Sub
161 [示例04-11-02]隐藏列
162 Sub HideColumn()
163   Dim iColumn As Long
164   MsgBox "隐藏当前单元格所在列"
165   iColumn = ActiveCell.Column
166   ActiveSheet.Columns(iColumn).Hidden = True
167   MsgBox "取消隐藏"
168   ActiveSheet.Columns(iColumn).Hidden = False
169 End Sub
170 [示例04-11-03]插入行
171 Sub InsertRow()
172   Dim rRow As Long
173   MsgBox "在当前单元格上方插入一行"
174   rRow = Selection.Row
175   ActiveSheet.Rows(rRow).Insert
176 End Sub
177 [示例04-11-04]插入列
178 Sub InsertColumn()
179   Dim cColumn As Long
180   MsgBox "在当前单元格所在行的左边插入一行"
181   cColumn = Selection.Column
182   ActiveSheet.Columns(cColumn).Insert
183 End Sub
184 [示例04-11-05]插入多行
185 Sub InsertManyRow()
186   MsgBox "在当前单元格所在行上方插入三行"
187   Dim rRow As Long, i As Long
188   For i = 1 To 3
189     rRow = Selection.Row
190     ActiveSheet.Rows(rRow).Insert
191   Next i
192 End Sub
193 [示例04-11-06]设置行高
194 Sub SetRowHeight()
195   MsgBox "将当前单元格所在的行高设置为25"
196   Dim rRow As Long, iRow As Long
197   rRow = ActiveCell.Row
198   iRow = ActiveSheet.Rows(rRow).RowHeight
199   ActiveSheet.Rows(rRow).RowHeight = 25
200   MsgBox "恢复到原来的行高"
201   ActiveSheet.Rows(rRow).RowHeight = iRow
202 End Sub
203 [示例04-11-07]设置列宽
204 Sub SetColumnWidth()
205   MsgBox "将当前单元格所在列的列宽设置为20"
206   Dim cColumn As Long, iColumn As Long
207   cColumn = ActiveCell.Column
208   iColumn = ActiveSheet.Columns(cColumn).ColumnWidth
209   ActiveSheet.Columns(cColumn).ColumnWidth = 20
210   MsgBox "恢复至原来的列宽"
211   ActiveSheet.Columns(cColumn).ColumnWidth = iColumn
212 End Sub
213 [示例04-11-08]恢复行高列宽至标准值
214 Sub ReSetRowHeightAndColumnWidth()
215   MsgBox "将当前单元格所在的行高和列宽恢复为标准值"
216   Selection.UseStandardHeight = True
217   Selection.UseStandardWidth = True
218 End Sub
219 [示例04-12]工作表标签
220 [示例04-12-01] 设置工作表标签的颜色
221 Sub SetSheetTabColor()
222   MsgBox "设置当前工作表标签的颜色"
223   ActiveSheet.Tab.ColorIndex = 7
224 End Sub
225 [示例04-12-01]恢复工作表标签颜色
226 Sub SetSheetTabColorDefault()
227   MsgBox "将当前工作表标签颜色设置为默认值"
228   ActiveSheet.Tab.ColorIndex = -4142
229 End Sub
230 [示例04-12-03]交替隐藏或显示工作表标签
231 Sub HideOrShowSheetTab()
232   MsgBox "隐藏/显示工作表标签"
233   ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
234 End Sub
235 [NextPage][示例04-13]确定打印的页数(HPageBreaks属性与VPageBreaks属性)
236 Sub PageCount()
237   Dim i As Long
238   i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
239   MsgBox "当前工作表共" & i & "页."
240 End Sub
241 [示例04-14]保护/撤销保护工作表
242 [示例04-14-01]
243 Sub ProtectSheet()
244   MsgBox "保护当前工作表并设定密码"
245   ActiveSheet.Protect Password:="fanjy"
246 End Sub
247 示例说明：运行代码后，当前工作表中将不允许编辑，除非撤销工作表保护。
248 [示例04-14-02]
249 Sub UnprotectSheet()
250   MsgBox "撤销当前工作表保护"
251   ActiveSheet.Unprotect
252 End Sub
253 示例说明：运行代码后，如果原保护的工作表设置有密码，则要求输入密码。
254 [示例04-14-03]保护当前工作簿中的所有工作表
255 Sub ProtectAllWorkSheets()
256   On Error Resume Next
257   Dim ws As Worksheet
258   Dim myPassword As String
259   myPassword = InputBox("请输入您的密码" & vbCrLf & _
260    "(不输入表明无密码)" & vbCrLf & vbCrLf & _
261    "确保您没有忘记密码！", "输入密码")
262   For Each ws In ThisWorkbook.Worksheets
263     ws.Protect (myPassword)
264   Next ws
265 End Sub
266 [示例04-14-04]撤销对当前工作簿中所有工作表的保护
267 Sub UnprotectAllWorkSheets()
268   On Error Resume Next
269   Dim ws As Worksheet
270   Dim myPassword As String
271   myPassword = InputBox("请输入您的密码" & vbCrLf & _
272     "(不输入表示无密码)", "输入密码")
273   For Each ws In ThisWorkbook.Worksheets
274     ws.Unprotect (myPassword)
275   Next ws
276 End Sub
277 [示例04-14-05]仅能编辑未锁定的单元格
278 Sub OnlyEditUnlockedCells()
279   Sheets("Sheet1").EnableSelection = xlUnlockedCells
280   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
281 End Sub
282 示例说明：运行本代码后，在当前工作表中将只能对未锁定的单元格进行编辑，而其它单元格将不能编辑。未锁定的单元格是指在选择菜单“格式——单元格”命令后所弹出的对话框中的“保护”选项卡中，未选中“锁定”复选框的单元格或单元格区域。
283 [示例04-15]删除工作表(Delete方法)
284 Sub DeleteWorksheet()
285   MsgBox "删除当前工作簿中的工作表sheet2"
286   Application.DisplayAlerts = False
287   Worksheets("sheet2").Delete
288   Application.DisplayAlerts = True
289 End Sub
290 示例说明：本示例代码使用Application.DisplayAlerts = False来屏蔽弹出的警告框。
291 <一些编程方法和技巧>
292 [示例04-16] 判断一个工作表(名)是否存在
293 [示例04-16-01]
294 Sub testWorksheetExists1()
295   Dim ws As Worksheet
296   If Not WorksheetExists(ThisWorkbook, "sheet1") Then
297     MsgBox "不能够找到该工作表", vbOKOnly
298     Exit Sub
299   End If
300   MsgBox "已经找到工作表"
301   Set ws = ThisWorkbook.Worksheets("sheet1")
302 End Sub
303 '- - - - - - - - - - - - - - - - - - -
304 Function WorksheetExists(wb As Workbook, sName As String) As Boolean
305   Dim s As String
306   On Error GoTo ErrHandle
307   s = wb.Worksheets(sName).Name
308   WorksheetExists = True
309   Exit Function
310 ErrHandle:
311   WorksheetExists = False
312 End Function
313 示例说明：在测试代码中，用相应的工作簿名和工作表名分别代替“ThisWorkbook”和“Sheet1”，来判断指定工作表是否在工作簿中存在。
314 [示例04-16-02]
315 Sub testWorksheetExists2()
316   If Not SheetExists("<工作表名>") Then
317     MsgBox "<工作表名> 不存在!"
318   Else
319     Sheets("<工作表名>").Activate
320   End If
321 End Sub
322 '- - - - - - - - - - - - - - - - - - -
323 Function SheetExists(SheetName As String) As Boolean
324   SheetExists = False
325   On Error GoTo NoSuchSheet
326   If Len(Sheets(SheetName).Name) > 0 Then
327     SheetExists = True
328     Exit Function
329   End If
330 NoSuchSheet:
331 End Function
332 示例说明：在代码中，用实际工作表名代替<>。
333 [示例04-16-03]
334 Sub TestingFunction()
335  '如果工作表存在则返回True，否则为False
336   '测试DoesWksExist1函数
337   Debug.Print DoesWksExist1("Sheet1")
338   Debug.Print DoesWksExist1("Sheet100")
339   Debug.Print "-----"
340   '测试DoesWksExist2函数
341   Debug.Print DoesWksExist2("Sheet1")
342   Debug.Print DoesWksExist2("Sheet100")
343 End Sub
344 ‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
345 Function DoesWksExist1(sWksName As String) As Boolean
346   Dim i As Long
347   For i = Worksheets.Count To 1 Step -1
348     If Sheets(i).Name = sWksName Then
349       Exit For
350     End If
351   Next
352   If i = 0 Then
353     DoesWksExist1 = False
354   Else
355     DoesWksExist1 = True
356   End If
357 End Function
358 ‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
359 Function DoesWksExist2(sWksName As String) As Boolean
360   Dim wkb As Worksheet
361   On Error Resume Next
362   Set wkb = Sheets(sWksName)
363   On Error GoTo 0
364   DoesWksExist2 = IIf(Not wkb Is Nothing, True, False)
365 End Function 
366 [示例04-17]排序工作表
367 [示例04-17-01]
368 Sub SortWorksheets1()
369   Dim bSorted As Boolean
370   Dim nSortedSheets As Long
371   Dim nSheets As Long
372   Dim n As Long
373   nSheets = Worksheets.Count
374   nSortedSheets = 0
375   Do While (nSortedSheets < nSheets) And Not bSorted
376     bSorted = True
377     nSortedSheets = nSortedSheets + 1
378     For n = 1 To nSheets - nSortedSheets
379       If StrComp(Worksheets(n).Name, Worksheets(n + 1).Name, vbTextCompare) > 0 Then
380         Worksheets(n + 1).Move Before:=Worksheets(n)
381         bSorted = False
382       End If
383     Next n
384    Loop
385 End Sub
386 示例说明：本示例代码采用了冒泡法排序。
387 [示例04-17-02]
388 Sub SortWorksheets2()
389   '根据字母对工作表排序
390   Dim i As Long, j As Long
391   For i = 1 To Sheets.Count
392     For j = 1 To Sheets.Count - 1
393       If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
394         Sheets(j).Move After:=Sheets(j + 1)
395       End If
396     Next j
397   Next i
398 End Sub
399 [示例04-17-03]
400 Sub SortWorksheets3()
401  '以升序排列工作表
402   Dim sCount As Integer, i As Integer, j As Integer
403   Application.ScreenUpdating = False
404   sCount = Worksheets.Count
405   If sCount = 1 Then Exit Sub
406   For i = 1 To sCount - 1
407     For j = i + 1 To sCount
408       If Worksheets(j).Name < Worksheets(i).Name Then
409         Worksheets(j).Move Before:=Worksheets(i)
410       End If
411     Next j
412   Next i
413 End Sub
414 示例说明：若想排序所有工作表，将代码中的Worksheets替换为Sheets。
415 [示例04-18]删除当前工作簿中的空工作表
416 Sub Delete_EmptySheets()
417     Dim sh As Worksheet
418     For Each sh In ThisWorkbook.Worksheets
419       If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then
420         Application.DisplayAlerts = False
421         sh.Delete
422         Application.DisplayAlerts = True
423       End If
424     Next
425 End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
  1 工作表(Worksheet)基本操作应用示例
  2 作者：fanjy | 来源：ExcelHomeBlog | 时间：2006-12-21 | 阅读权限：游客 | 会员币：0 | 【大 中 小】
  3 在编写代码时，经常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、删除工作表、复制工作表、移动工作表、重命名工作表，等等。下面介绍与此有关及相关的一些属性和方法示例。
  4 [示例04-01]增加工作表(Add方法)
  5 Sub AddWorksheet()
  6   MsgBox "在当前工作簿中添加一个工作表"
  7   Worksheets.Add
  8   MsgBox "在当前工作簿中的工作表sheet2之前添加一个工作表"
  9   Worksheets.Add before:=Worksheets("sheet2")
 10   MsgBox "在当前工作簿中的工作表sheet2之后添加一个工作表"
 11   Worksheets.Add after:=Worksheets("sheet2")
 12   MsgBox "在当前工作簿中添加3个工作表"
 13   Worksheets.Add Count:=3
 14 End Sub
 15 示例说明：Add方法带有4个可选的参数，其中参数Before和参数After指定所增加的工作表的位置，但两个参数只能选一；参数Count用来指定增加的工作表数目。
 16 [示例04-02]复制工作表(Copy方法)
 17 Sub CopyWorksheet()
 18   MsgBox "在当前工作簿中复制工作表sheet1并将所复制的工作表放在工作表sheet2之前"
 19   Worksheets("sheet1").Copy Before:=Worksheets("sheet2")
 20   MsgBox "在当前工作簿中复制工作表sheet2并将所复制的工作表放在工作表sheet3之后"
 21   Worksheets("sheet2").Copy After:=Worksheets("sheet3")
 22 End Sub
 23 示例说明：Copy方法带有2个可选的参数，即参数Before和参数After，在使用时两个参数只参选一。
 24 [示例04-03]移动工作表(Move方法)
 25 Sub MoveWorksheet()
 26   MsgBox "在当前工作簿中将工作表sheet3移至工作表sheet2之前"
 27   Worksheets("sheet3").Move Before:=Worksheets("sheet2")
 28   MsgBox "在当前工作簿中将工作表sheet1移至最后"
 29   Worksheets("sheet1").Move After:=Worksheets(Worksheets.Count)
 30 End Sub
 31 示例说明：Move方法与Copy方法的参数相同，作用也一样。
 32 [示例04-04]隐藏和显示工作表(Visible属性)
 33 [示例04-04-01]
 34 Sub testHide()
 35   MsgBox "第一次隐藏工作表sheet1"
 36   Worksheets("sheet1").Visible = False
 37   MsgBox "显示工作表sheet1"
 38   Worksheets("sheet1").Visible = True
 39   MsgBox "第二次隐藏工作表sheet1"
 40   Worksheets("sheet1").Visible = xlSheetHidden
 41   MsgBox "显示工作表sheet1"
 42   Worksheets("sheet1").Visible = True
 43   MsgBox "第三次隐藏工作表sheet1"
 44   Worksheets("sheet1").Visible = xlSheetHidden
 45   MsgBox "显示工作表sheet1"
 46   Worksheets("sheet1").Visible = xlSheetVisible
 47   MsgBox "第四隐藏工作表sheet1"
 48   Worksheets("sheet1").Visible = xlSheetVeryHidden
 49   MsgBox "显示工作表sheet1"
 50   Worksheets("sheet1").Visible = True
 51   MsgBox "第五隐藏工作表sheet1"
 52   Worksheets("sheet1").Visible = xlSheetVeryHidden
 53   MsgBox "显示工作表sheet1"
 54   Worksheets("sheet1").Visible = xlSheetVisible
 55 End Sub
 56 示例说明：本示例演示了隐藏和显示工作表的各种情形。其中，使用xlSheetVeryHidden常量来隐藏工作表，将不能通过选择工作表菜单栏中的“格式”——“工作表”——“取消隐藏”命令来取消隐藏。
 57 [示例04-04-02]
 58 Sub ShowAllSheets()
 59   MsgBox "使当前工作簿中的所有工作表都显示(即将隐藏的工作表也显示)"
 60   Dim ws As Worksheet
 61   For Each ws In Sheets
 62     ws.Visible = True
 63   Next ws
 64 End Sub
 65 [示例04-05]获取工作表数(Count属性)
 66 [示例04-05-01]
 67 Sub WorksheetNum()
 68   Dim i As Long
 69   i = Worksheets.Count
 70   MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
 71 End Sub
 72 [示例04-05-02]
 73 Sub WorksheetNum()
 74   Dim i As Long
 75   i = Sheets.Count
 76   MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
 77 End Sub
 78 示例说明：在一个包含图表工作表的工作簿中运行上述两段代码，将会得出不同的结果，原因是对于Sheets集合来讲，工作表包含图表工作表。应注意Worksheets集合与Sheets集合的区别，下同。
 79 [示例04-06]获取或设置工作表名称(Name属性)
 80 [示例04-06-01]
 81 Sub NameWorksheet()
 82   Dim sName As String, sChangeName As String
 83   sName = Worksheets(2).Name
 84   MsgBox "当前工作簿中第2个工作表的名字为：" & sName
 85   sChangeName = "我的工作表"
 86   MsgBox "将当前工作簿中的第3个工作表名改为：" & sChangeName
 87   Worksheets(3).Name = sChangeName
 88 End Sub
 89 示例说明：使用Name属性可以获取指定工作表的名称，也可以设置工作表的名称。
 90 [示例04-06-02]重命名工作表
 91 Sub ReNameSheet()
 92    Dim xStr As String
 93 Retry:
 94    Err.Clear
 95    xStr = InputBox("请输入工作表的新名称:" _
 96        , "重命名工作表", ActiveSheet.Name)
 97    If xStr = "" Then Exit Sub
 98    On Error Resume Next
 99    ActiveSheet.Name = xStr
100    If Err.Number <> 0 Then
101      MsgBox Err.Number & " " & Err.Description
102      Err.Clear
103      GoTo Retry
104     End If
105     On Error GoTo 0
106     '.........
107  End Sub
108 [NextPage][示例04-07]激活/选择工作表(Activate方法和Select方法)
109 [示例04-07-01]
110 Sub SelectWorksheet()
111   MsgBox "激活当前工作簿中的工作表sheet2"
112   Worksheets("sheet2").Activate
113   MsgBox "激活当前工作簿中的工作表sheet3"
114   Worksheets("sheet3").Select
115   MsgBox "同时选择工作簿中的工作表sheet2和sheet3"
116   Worksheets(Array("sheet2", "sheet3")).Select
117 End Sub
118 示例说明：Activate方法只能激活一个工作表，而Select方法可以同时选择多个工作表。
119 [示例04-07-02]
120 Sub SelectManySheet()
121   MsgBox "选取第一个和第三个工作表."
122   Worksheets(1).Select
123   Worksheets(3).Select False
124 End Sub
125 [示例04-08]获取当前工作表的索引号(Index属性)
126 Sub GetSheetIndex()
127   Dim i As Long
128   i = ActiveSheet.Index
129   MsgBox "您正使用的工作表索引号为" & i
130 End Sub
131 [示例04-09]选取前一个工作表(Previous属性)
132 Sub PreviousSheet()
133   If ActiveSheet.Index <> 1 Then
134     MsgBox "选取当前工作簿中当前工作表的前一个工作表"
135     ActiveSheet.Previous.Activate
136   Else
137     MsgBox "已到第一个工作表"
138   End If
139 End Sub
140 示例说明：如果当前工作表是第一个工作表，则使用Previous属性会出错。
141 [示例04-10]选取下一个工作表(Next属性)
142 Sub NextSheet()
143   If ActiveSheet.Index <> Worksheets.Count Then
144     MsgBox "选取当前工作簿中当前工作表的下一个工作表"
145     ActiveSheet.Next.Activate
146   Else
147     MsgBox “已到最后一个工作表”
148   End If
149 End Sub
150 示例说明：如果当前工作表是最后一个工作表，则使用Next属性会出错。
151 [示例04-11]工作表行和列的操作
152 [示例04-11-01]隐藏行
153 Sub HideRow()
154   Dim iRow As Long
155   MsgBox "隐藏当前单元格所在的行"
156   iRow = ActiveCell.Row
157   ActiveSheet.Rows(iRow).Hidden = True
158   MsgBox "取消隐藏"
159   ActiveSheet.Rows(iRow).Hidden = False
160 End Sub
161 [示例04-11-02]隐藏列
162 Sub HideColumn()
163   Dim iColumn As Long
164   MsgBox "隐藏当前单元格所在列"
165   iColumn = ActiveCell.Column
166   ActiveSheet.Columns(iColumn).Hidden = True
167   MsgBox "取消隐藏"
168   ActiveSheet.Columns(iColumn).Hidden = False
169 End Sub
170 [示例04-11-03]插入行
171 Sub InsertRow()
172   Dim rRow As Long
173   MsgBox "在当前单元格上方插入一行"
174   rRow = Selection.Row
175   ActiveSheet.Rows(rRow).Insert
176 End Sub
177 [示例04-11-04]插入列
178 Sub InsertColumn()
179   Dim cColumn As Long
180   MsgBox "在当前单元格所在行的左边插入一行"
181   cColumn = Selection.Column
182   ActiveSheet.Columns(cColumn).Insert
183 End Sub
184 [示例04-11-05]插入多行
185 Sub InsertManyRow()
186   MsgBox "在当前单元格所在行上方插入三行"
187   Dim rRow As Long, i As Long
188   For i = 1 To 3
189     rRow = Selection.Row
190     ActiveSheet.Rows(rRow).Insert
191   Next i
192 End Sub
193 [示例04-11-06]设置行高
194 Sub SetRowHeight()
195   MsgBox "将当前单元格所在的行高设置为25"
196   Dim rRow As Long, iRow As Long
197   rRow = ActiveCell.Row
198   iRow = ActiveSheet.Rows(rRow).RowHeight
199   ActiveSheet.Rows(rRow).RowHeight = 25
200   MsgBox "恢复到原来的行高"
201   ActiveSheet.Rows(rRow).RowHeight = iRow
202 End Sub
203 [示例04-11-07]设置列宽
204 Sub SetColumnWidth()
205   MsgBox "将当前单元格所在列的列宽设置为20"
206   Dim cColumn As Long, iColumn As Long
207   cColumn = ActiveCell.Column
208   iColumn = ActiveSheet.Columns(cColumn).ColumnWidth
209   ActiveSheet.Columns(cColumn).ColumnWidth = 20
210   MsgBox "恢复至原来的列宽"
211   ActiveSheet.Columns(cColumn).ColumnWidth = iColumn
212 End Sub
213 [示例04-11-08]恢复行高列宽至标准值
214 Sub ReSetRowHeightAndColumnWidth()
215   MsgBox "将当前单元格所在的行高和列宽恢复为标准值"
216   Selection.UseStandardHeight = True
217   Selection.UseStandardWidth = True
218 End Sub
219 [示例04-12]工作表标签
220 [示例04-12-01] 设置工作表标签的颜色
221 Sub SetSheetTabColor()
222   MsgBox "设置当前工作表标签的颜色"
223   ActiveSheet.Tab.ColorIndex = 7
224 End Sub
225 [示例04-12-01]恢复工作表标签颜色
226 Sub SetSheetTabColorDefault()
227   MsgBox "将当前工作表标签颜色设置为默认值"
228   ActiveSheet.Tab.ColorIndex = -4142
229 End Sub
230 [示例04-12-03]交替隐藏或显示工作表标签
231 Sub HideOrShowSheetTab()
232   MsgBox "隐藏/显示工作表标签"
233   ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
234 End Sub
235 [NextPage][示例04-13]确定打印的页数(HPageBreaks属性与VPageBreaks属性)
236 Sub PageCount()
237   Dim i As Long
238   i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
239   MsgBox "当前工作表共" & i & "页."
240 End Sub
241 [示例04-14]保护/撤销保护工作表
242 [示例04-14-01]
243 Sub ProtectSheet()
244   MsgBox "保护当前工作表并设定密码"
245   ActiveSheet.Protect Password:="fanjy"
246 End Sub
247 示例说明：运行代码后，当前工作表中将不允许编辑，除非撤销工作表保护。
248 [示例04-14-02]
249 Sub UnprotectSheet()
250   MsgBox "撤销当前工作表保护"
251   ActiveSheet.Unprotect
252 End Sub
253 示例说明：运行代码后，如果原保护的工作表设置有密码，则要求输入密码。
254 [示例04-14-03]保护当前工作簿中的所有工作表
255 Sub ProtectAllWorkSheets()
256   On Error Resume Next
257   Dim ws As Worksheet
258   Dim myPassword As String
259   myPassword = InputBox("请输入您的密码" & vbCrLf & _
260    "(不输入表明无密码)" & vbCrLf & vbCrLf & _
261    "确保您没有忘记密码！", "输入密码")
262   For Each ws In ThisWorkbook.Worksheets
263     ws.Protect (myPassword)
264   Next ws
265 End Sub
266 [示例04-14-04]撤销对当前工作簿中所有工作表的保护
267 Sub UnprotectAllWorkSheets()
268   On Error Resume Next
269   Dim ws As Worksheet
270   Dim myPassword As String
271   myPassword = InputBox("请输入您的密码" & vbCrLf & _
272     "(不输入表示无密码)", "输入密码")
273   For Each ws In ThisWorkbook.Worksheets
274     ws.Unprotect (myPassword)
275   Next ws
276 End Sub
277 [示例04-14-05]仅能编辑未锁定的单元格
278 Sub OnlyEditUnlockedCells()
279   Sheets("Sheet1").EnableSelection = xlUnlockedCells
280   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
281 End Sub
282 示例说明：运行本代码后，在当前工作表中将只能对未锁定的单元格进行编辑，而其它单元格将不能编辑。未锁定的单元格是指在选择菜单“格式——单元格”命令后所弹出的对话框中的“保护”选项卡中，未选中“锁定”复选框的单元格或单元格区域。
283 [示例04-15]删除工作表(Delete方法)
284 Sub DeleteWorksheet()
285   MsgBox "删除当前工作簿中的工作表sheet2"
286   Application.DisplayAlerts = False
287   Worksheets("sheet2").Delete
288   Application.DisplayAlerts = True
289 End Sub
290 示例说明：本示例代码使用Application.DisplayAlerts = False来屏蔽弹出的警告框。
291 <一些编程方法和技巧>
292 [示例04-16] 判断一个工作表(名)是否存在
293 [示例04-16-01]
294 Sub testWorksheetExists1()
295   Dim ws As Worksheet
296   If Not WorksheetExists(ThisWorkbook, "sheet1") Then
297     MsgBox "不能够找到该工作表", vbOKOnly
298     Exit Sub
299   End If
300   MsgBox "已经找到工作表"
301   Set ws = ThisWorkbook.Worksheets("sheet1")
302 End Sub
303 '- - - - - - - - - - - - - - - - - - -
304 Function WorksheetExists(wb As Workbook, sName As String) As Boolean
305   Dim s As String
306   On Error GoTo ErrHandle
307   s = wb.Worksheets(sName).Name
308   WorksheetExists = True
309   Exit Function
310 ErrHandle:
311   WorksheetExists = False
312 End Function
313 示例说明：在测试代码中，用相应的工作簿名和工作表名分别代替“ThisWorkbook”和“Sheet1”，来判断指定工作表是否在工作簿中存在。
314 [示例04-16-02]
315 Sub testWorksheetExists2()
316   If Not SheetExists("<工作表名>") Then
317     MsgBox "<工作表名> 不存在!"
318   Else
319     Sheets("<工作表名>").Activate
320   End If
321 End Sub
322 '- - - - - - - - - - - - - - - - - - -
323 Function SheetExists(SheetName As String) As Boolean
324   SheetExists = False
325   On Error GoTo NoSuchSheet
326   If Len(Sheets(SheetName).Name) > 0 Then
327     SheetExists = True
328     Exit Function
329   End If
330 NoSuchSheet:
331 End Function
332 示例说明：在代码中，用实际工作表名代替<>。
333 [示例04-16-03]
334 Sub TestingFunction()
335  '如果工作表存在则返回True，否则为False
336   '测试DoesWksExist1函数
337   Debug.Print DoesWksExist1("Sheet1")
338   Debug.Print DoesWksExist1("Sheet100")
339   Debug.Print "-----"
340   '测试DoesWksExist2函数
341   Debug.Print DoesWksExist2("Sheet1")
342   Debug.Print DoesWksExist2("Sheet100")
343 End Sub
344 ‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
345 Function DoesWksExist1(sWksName As String) As Boolean
346   Dim i As Long
347   For i = Worksheets.Count To 1 Step -1
348     If Sheets(i).Name = sWksName Then
349       Exit For
350     End If
351   Next
352   If i = 0 Then
353     DoesWksExist1 = False
354   Else
355     DoesWksExist1 = True
356   End If
357 End Function
358 ‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
359 Function DoesWksExist2(sWksName As String) As Boolean
360   Dim wkb As Worksheet
361   On Error Resume Next
362   Set wkb = Sheets(sWksName)
363   On Error GoTo 0
364   DoesWksExist2 = IIf(Not wkb Is Nothing, True, False)
365 End Function 
366 [示例04-17]排序工作表
367 [示例04-17-01]
368 Sub SortWorksheets1()
369   Dim bSorted As Boolean
370   Dim nSortedSheets As Long
371   Dim nSheets As Long
372   Dim n As Long
373   nSheets = Worksheets.Count
374   nSortedSheets = 0
375   Do While (nSortedSheets < nSheets) And Not bSorted
376     bSorted = True
377     nSortedSheets = nSortedSheets + 1
378     For n = 1 To nSheets - nSortedSheets
379       If StrComp(Worksheets(n).Name, Worksheets(n + 1).Name, vbTextCompare) > 0 Then
380         Worksheets(n + 1).Move Before:=Worksheets(n)
381         bSorted = False
382       End If
383     Next n
384    Loop
385 End Sub
386 示例说明：本示例代码采用了冒泡法排序。
387 [示例04-17-02]
388 Sub SortWorksheets2()
389   '根据字母对工作表排序
390   Dim i As Long, j As Long
391   For i = 1 To Sheets.Count
392     For j = 1 To Sheets.Count - 1
393       If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
394         Sheets(j).Move After:=Sheets(j + 1)
395       End If
396     Next j
397   Next i
398 End Sub
399 [示例04-17-03]
400 Sub SortWorksheets3()
401  '以升序排列工作表
402   Dim sCount As Integer, i As Integer, j As Integer
403   Application.ScreenUpdating = False
404   sCount = Worksheets.Count
405   If sCount = 1 Then Exit Sub
406   For i = 1 To sCount - 1
407     For j = i + 1 To sCount
408       If Worksheets(j).Name < Worksheets(i).Name Then
409         Worksheets(j).Move Before:=Worksheets(i)
410       End If
411     Next j
412   Next i
413 End Sub
414 示例说明：若想排序所有工作表，将代码中的Worksheets替换为Sheets。
415 [示例04-18]删除当前工作簿中的空工作表
416 Sub Delete_EmptySheets()
417     Dim sh As Worksheet
418     For Each sh In ThisWorkbook.Worksheets
419       If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then
420         Application.DisplayAlerts = False
421         sh.Delete
422         Application.DisplayAlerts = True
423       End If
424     Next
425 End Sub