目錄
第1章 宏的應用技巧
宏是一個VBA程序，通過宏可以完成枯燥的、頻繁的重復性工作。本章的實例分別介紹在Excel 2003、Excel 2007中錄制宏、使用Visual Basic代碼創建宏的方法，最后還以實例演示運行宏和編輯宏的方法。
1.1 創建宏 1
例001 在Excel 2003中錄制宏 1
例002 打開Excel 2007的錄制宏功能 3
例003 在Excel 2007中錄制宏 4
例004 使用Visual Basic創建宏 5
1.2 管理宏 6
例005 運行宏 7
例006 編輯宏 8
第2章 VBE使用技巧
VBE（Visual Basic Editor）是編寫VBA代碼的工具，在上一章中曾使用VBE編輯宏代碼。本章的實例介紹了設置VBE操作環境、在VBE中管理工程代碼、使用VBE的輔助工具提高代碼輸入效率等方法。
2.1 設置VBE操作環境 10
例007 停靠VBE子窗口 10
例008 定制VBE環境 12
2.2 工程管理 13
例009 增加模塊 13
例010 刪除模塊 15
例011 導出模塊 16
例012 導入模塊 17
2.3 管理代碼 18
例013 屬性/方法列表 18
例014 常數列表 19
例015 參數信息 20
例016 自動完成關鍵字 21
第3章 程序控制流程技巧
結構化程序設計中使用的基本控制結構有3種：順序結構、選擇結構和循環結構。
本章以實例演示了VBA中這三種控制結構的控制語句，最后還介紹了在VBA中使用數組的方法。
3.1 常用輸入/輸出語句 23
例017 九九乘法表（Print方法的應用） 23
例018 輸入個人信息（Inputbox函數的應用） 24
例019 退出確認（Msgbox函數的應用） 25
3.2 分支結構 27
例020 突出顯示不及格學生 27
例021 從身份證號碼中提取性別 29
例022 評定成績等級 30
例023 計算個人所得稅 32
3.3 循環結構 34
例024 密碼驗證 34
例025 求最小公倍數和最大公約數 36
例026 輸出ASCII碼表 37
例027 計算選中區域數值之和 39
例028 換零錢法（多重循環） 40
3.4 使用數組 42
例029 數據排序 42
例030 彩票幸運號碼 44
例031 用數組填充單元格區域 46
第4章 Range對象操作技巧
用戶在使用Excel時，大部分時間都是在操作單元格中的數據，同樣地，在Excel中使用VBA編程時，也需要頻繁地引用單元格區域。本章實例介紹用VBA引用單元格、獲取單元格信息、操作單元格數據、設置單元格格式等內容。
4.1 獲取單元格的引用 48
例032 使用A1樣式引用單元格 48
例033 使用索引號引用單元格 49
例034 引用多個單元格區域 50
例035 合并單元格區域 51
例036 引用合并區域的子區域 52
例037 動態選中單元格區域 53
例038 引用相對其他單元格的單元格 54
例039 擴展單元格區域 55
例040 引用單元格交叉區域 56
例041 引用當前區域 57
例042 獲取已使用區域 58
例043 引用區域內的單元格 59
例044 設置標題行格式 61
例045 選取條件格式單元格 62
例046 選擇數據列末單元格 63
例047 獲取某列連續數據區域 64
例048 獲取多個不同長度的非連續列 65
例049 當前單元格的前后單元格 65
例050 獲取三維區域 66
4.2 獲取單元格信息 67
例051 獲取標題行和數據行 67
例052 獲取當前區域信息 68
例053 單元格區域是否有公式 69
例054 追蹤公式單元格 70
例055 獲取單元格地址 71
4.3 操作單元格 72
例056 合并相同值單元格 72
例057 刪除指定字符后的內容 73
例058 給單元格設置錯誤值 75
例059 活動單元格錯誤類型 76
例060 自動設置打印區域 77
例061 按設置長度換行 77
例062 選擇不含公式的單元格 79
例063 生成不重復隨機數 80
例064 拆分單元格 82
例065 添加超鏈接 83
例066 刪除超鏈接 84
例067 限制單元格移動范圍 85
例068 插入批注 86
例069 隱藏/顯示批注 87
例070 刪除批注 87
例071 復制單元格區域 88
例072 給單元格設置公式 90
例073 復制公式 90
例074 查找并填充空白單元格 91
例075 清除單元格 92
例076 刪除單元格區域 93
4.4 設置單元格格式 94
例077 按顏色統計單元格數量 94
例078 獲取單元格底紋和圖案 95
例079 設置頁眉為單元格值 96
例080 設置日期格式 97
例081 生成大寫金額 98
例082 格式化當前區域的數據 100
例083 設置自動套用格式 101
例084 突出顯示當前位置 101
例085 設置邊框線 103
例086 設置文本對齊格式 104
例087 單元格文本縮排 105
例088 設置文本方向 107
例089 設置自動換行格式 108
例090 設置縮小字體填充 108
例091 設置條件格式 109
例092 設置單元格圖案 111
例093 合并單元格 112
第5章 Worksheet對象操作技巧
Worksheet對象表示Excel工作簿中的工作表，Worksheet對象是Worksheets集合的成員。在VBA中，通過操作Worksheet對象和Worksheets集合對象，即可控制Excel的工作表。本章實例介紹了用VBA代碼操作工作表、操作工作表行和列、通過工作表事件控制工作表等內容。
5.1 控制工作表集合 114
例094 增加工作表 114
例095 窗體方式新增工作表 115
例096 窗體方式刪除工作表 118
例097 批量新建工作表 119
例098 獲取工作表數 120
例099 循環激活工作表 121
例100 選擇工作表 121
例101 選取前一個工作表/后一個工作表 122
例102 選中工作表的名稱 123
例103 保護工作表 124
例104 撤銷工作表的保護 126
例105 判斷工作表是否存在 127
例106 工作表排序 129
例107 復制工作表 130
例108 移動工作表 131
例109 刪除工作表 132
例110 刪除空工作表 133
例111 密碼控制刪除工作表 134
例112 隱藏/顯示工作表 135
例113 工作表移至最前/最后 136
例114 工作表打印頁數 137
例115 重命名工作表 138
例116 設置工作表標簽顏色 140
例117 導出工作表 141
5.2 操作工作表的行和列 144
例118 刪除空行 144
例119 插入行 145
例120 插入多行 146
例121 插入列 147
例122 隱藏/顯示行 148
例123 隱藏/顯示列 149
例124 設置行高 149
例125 設置列寬 151
5.3 操作工作表 152
例126 合并工作表數據 152
例127 工作表是否被保護 153
例128 制作工作表目錄 154
例129 刪除圖片 155
例130 修改工作表的代碼名 156
5.4 控制工作表事件 158
例131 為輸入數據的單元格添加批注 158
例132 自動填充相同值 159
例133 記錄同一單元格多次輸入值 160
例134 禁止選中某個區域 161
例135 禁止輸入相同數據 162
例136 設置滾動區域 163
例137 自動添加邊框線 164
例138 限制在數據區域下一行輸入數據 165
例139 增加快捷菜單 166
例140 限制選擇其他工作表 168
例141 自動隱藏工作表 169
例142 將原數據作批注 170
例143 輸入編碼 171
第6章 Workbook對象操作技巧
Workbook對象表示Excel工作簿，Workbooks集合對象表示Excel中所有打開的工作簿。本章實例介紹VBA控制工作簿的方法，包括對工作簿集合和工作簿的操作、通過工作簿事件控制工作簿的操作。
6.1 操作工作簿集合 173
例144 批量新建工作簿 173
例145 設置背景音樂 174
例146 打開工作簿 176
例147 保存工作簿 177
例148 更名保存工作簿 178
例149 將工作簿保存為Web頁 180
例150 打開文本文件 181
例151 設置工作簿密碼 182
例152 保護工作簿 184
例153 查看文檔屬性 185
例154 處理命名單元格區域 187
例155 判斷工作簿是否存在 190
例156 判斷工作簿是否打開 191
例157 備份工作簿 192
例158 獲取關閉工作簿中的值（方法1） 194
例159 獲取關閉工作簿中的值（方法2） 196
例160 多工作簿數據合并 197
6.2 控制工作簿事件 199
例161 自動打開關聯工作簿 199
例162 禁止拖動單元格 200
例163 設置新增工作表為固定名稱 201
例164 退出前強制保存工作簿 202
例165 限制打印 203
例166 限制保存工作簿 204
例167 限制工作簿使用次數 205
例168 限制工作簿使用時間 207
例169 設置應用程序標題 207
例170 根據密碼打開工作簿 209
例171 打開工作簿禁用宏 210
例172 用VBA刪除宏代碼 212
第7章 Application對象操作技巧
Application對象代表整個Excel應用程序，使用Application對象可控制應用程序范圍的設置和選項。本章實例介紹使用VBA，通過Application對象自定義Excel外觀、設置Excel操作選項、控制Excel應用程序，以及通過Application對象的OnTime方法和OnKey方法響應用戶操作的內容。
7.1 自定義Excel外觀 214
例173 顯示/關閉編輯欄 214
例174 設置狀態欄 215
例175 控制鼠標指針形狀 217
例176 全屏幕顯示 218
例177 最大化Excel窗口 219
例178 查詢計算機信息 219
7.2 設置Excel操作選項 220
例179 關閉屏幕刷新 220
例180 禁止彈出警告信息 222
例181 復制/剪切模式 223
例182 獲取系統路徑 224
7.3 控制應用程序 225
例183 激活Microsoft應用程序 225
例184 控制最近使用文檔 226
例185 文件選擇器 228
例186 快速跳轉 230
例187 激活Excel 2007的功能區選項卡 232
7.4 Application對象事件處理 234
例188 工作表上顯示時鐘 234
例189 整點報時 235
例190 自定義功能鍵 236
第8章 Window對象操作技巧
Window對象代表一個窗口，許多工作表特征（如滾動條和標尺）實際上是窗口的屬性。本章實例介紹用VBA控制窗口的方法，包括通過Window對象的屬性和方法創建、拆分窗口、設置窗口大小、顯示比例、控制窗口顯示狀態等。
8.1 控制窗口 238
例191 創建窗口 238
例192 調整窗口大小 239
例193 獲取窗口狀態 242
例194 拆分窗格 243
例195 并排比較窗口 244
例196 排列窗口 245
例197 窗口顯示比例 246
8.2 控制工作表的顯示選項 248
例198 工作簿顯示選項 248
例199 工作表顯示選項 249
例200 工作表網格線 250
例201 獲取指定窗口選中的信息 252
第9章 Chart對象操作技巧
在Excel中可以快速簡便地創建圖表。在程序中，通過VBA代碼也可方便地創建圖表。本章實例介紹用VBA創建圖表（包括嵌入式圖表）、控制圖表中的對象、通過圖表事件響應用戶操作等內容。
9.1 創建圖表 254
例202 創建圖表工作表 254
例203 創建嵌入圖表 255
例204 轉換圖表類型 257
例205 刪除圖表 258
9.2 控制圖表對象 260
例206 獲取嵌入圖表的名稱 260
例207 獲取圖表標題信息 260
例208 獲取圖例信息 262
例209 獲取圖表坐標軸信息 263
例210 獲取圖表的系列信息 264
例211 判斷工作表的類型 265
例212 重排嵌入圖表 266
例213 調整圖表的數據源 268
例214 為圖表添加陰影 269
例215 顯示數據標簽 271
例216 將圖表保存為圖片 273
例217 設置圖表顏色 274
例218 按值顯示顏色 276
例219 修改嵌入圖表外形尺寸 277
例220 修改圖表標題 279
例221 修改坐標軸 280
例222 圖表插入到Word文檔 282
9.3 圖表事件 283
例223 激活圖表工作表 283
例224 顯示圖表各子對象名稱 284
例225 捕獲嵌入圖表事件 285
第10章 用戶界面設計技巧
在Excel中，用戶大部分時間是在工作表中進行操作。在Excel中，也可以設計用戶窗體，用戶直接在窗體上進行操作，而將工作表作為保存數據的地方。本章實例介紹在VBA中調用Excel內置對話框、在VBE中創建自定義窗體等內容。
10.1 使用內置對話框 288
例226 顯示打開對話框（使用GetOpenFilename方法） 288
例227 顯示保存文件對話框（使用GetSaveAsFilename方法） 290
例228 顯示內置對話框 291
例229 用VBA調用Excel 2007功能區功能 293
10.2 創建自定義窗體 294
例230 制作Splash窗口 294
例231 控制窗體顯示 295
例232 列表框間移動數據 297
例233 通過窗體向工作表添加數據 302
例234 制作多頁窗體——報名登記 305
例235 通過窗體設置單元格格式 307
例236 用窗體控制工作表顯示比例 308
例237 調色板窗體 311
例238 在窗體中顯示圖表 312
例239 制作向導窗體 314
例240 拖動窗體上的控件 317
例241 制作交通信號燈 318
例242 制作進度條 320
第11章 命令欄和功能區操作技巧
在Excel 2007中，以新的功能區取代了以前版本的命令欄（包括菜單欄和工具欄）。本章實例分別介紹了用VBA控制Excel 2003以前版本的命令欄、用XML自定義Excel 2007功能區等內容。
11.1 控制命令欄 322
例243 顯示內置菜單和工具欄的ID 322
例244 創建自定義菜單 323
例245 刪除自定義菜單 325
例246 創建快捷菜單 326
例247 禁止工作表標簽快捷菜單 328
例248 屏蔽工作表標簽部分快捷菜單 329
11.2 Excel 2007的功能區 330
例249 創建功能區選項卡 330
例250 禁用Office按鈕的菜單 332
例251 在“Office按鈕”中新建菜單 333
例252 重定義“Office按鈕”菜單項功能 335
例253 為內置選項卡增加功能 336
第12章 Excel處理工作表數據技巧
通過Excel相關對象可對工作表中的數據進行操作，如處理單元格區域的公式、對數據進行查詢、排序、篩選等操作。本章實例介紹了用VBA處理公式，對數據進行查詢、排序、篩選等內容。
12.1 處理公式 339
例254 判斷單元格是否包含公式 339
例255 自動填充公式 340
例256 鎖定和隱藏公式 341
例257 將單元格公式轉換為數值 342
例258 刪除所有公式 343
例259 用VBA表示數組公式 345
12.2 數據查詢 346
例260 查找指定的值 346
例261 帶格式查找 349
例262 查找上一個/下一個數據 349
例263 代碼轉換 351
例264 模糊查詢 353
例265 網上查詢快件信息 354
例266 查詢基金信息 357
例267 查詢手機所在地 358
例268 使用字典查詢360
12.3 數據排序 361
例269 用VBA代碼排序 362
例270 亂序排序 363
例271 自定義序列排序 364
例272 多關鍵字排序 366
例273 輸入數據自動排序 367
例274 數組排序 369
例275 使用Small和Large函數排序 370
例276 使用RANK函數排序 372
例277 姓名按筆畫排序 374
12.4 數據篩選 376
例278 用VBA進行簡單篩選 377
例279 用VBA進行高級篩選 378
例280 篩選非重復值 380
例281 取消篩選 381
第13章 Excel處理數據庫技巧
通過VBA代碼，可在Excel中訪問數據庫。本章實例介紹通過ADO訪問Excel工作簿中的數據、在Excel中處理Access數據庫（包括獲取、添加、修改、刪除記錄，創建Access數據）等內容。
13.1 用ADO訪問Excel工作表 383
例282 使用ADO連接數據庫 383
例283 從工作表中查詢數據 384
例284 使用ADO導出數據 386
例285 匯總數據 387
例286 不打開工作簿獲取工作表名稱 388
13.2 處理Access數據庫 390
例287 從Access中獲取數據 390
例288 添加數據到Access 391
例289 創建Access數據庫 393
例290 是否存在指定表 395
例291 列出數據庫的表名 396
例292 列出數據表的字段信息 398
例293 修改記錄 399
例294 刪除記錄 401
第14章 創建加載宏技巧
在Excel中，通過加載宏可以擴展功能，加載宏是為Excel提供自定義命令或自定義功能的補充程序。本章實例介紹了在Excel中通過VBA代碼創建Excel加載宏和COM加載宏的方法。
14.1 創建加載宏的方法 404
例295 創建Excel加載宏 404
例296 創建COM加載宏 408
例297 系統加載宏列表 413
14.2 常用加載宏示例 414
例298 時間提示 414
例299 大寫金額轉換 416
例300 計算個人所得稅 418
例301 加蓋公章 419
第15章 文件和文件夾操作技巧
通過VBA代碼可在Excel中操作文件。有兩種方式訪問操作文件和文件夾：一
是使用過程形式的VB訪問和操作方法，另一種是將文件系統作為對象的文件對象模型方式。本章實例介紹了用VB語句操作文件和文件夾、用FSO操作文件和文件夾的內容。
15.1 用VB語句操作文件和文件夾 422
例302 顯示指定文件夾的文件 422
例303 判斷文件（文件夾）是否存在 424
例304 新建文件夾 425
例305 復制文件 426
例306 重命名文件或文件夾 427
例307 刪除文件 429
例308 查看文件屬性 430
15.2 用FSO操作文件和文件夾 432
例309 判斷文件是否存在（FSO） 432
例310 分離文件名和擴展名 434
例311 新建和刪除文件夾（FSO） 435
例312 復制文件（FSO） 437
例313 復制文件夾（FSO） 439
例314 列出文件夾名稱 440
例315 顯示文件屬性 441
例316 刪除所有空文件夾 442
例317 顯示驅動器信息 444
第16章 文本文件操作技巧
上一章介紹了對文件進行復制、刪除之類的操作，更多的時候用戶還需要從文本文件中讀取數據，或向文本文件中寫入數據。本章實例介紹用VBA操作文本文件的內容，包括用VB語句操作文本文件和用FSO操作文本文件。
16.1 用VB語句操作文本文件 446
例318 創建文本文件 446
例319 讀取文本文件數據 448
例320 工作表保存為文本文件 450
例321 導出批注到文本文件 451
例322 從文本文件導入批注 453
16.2 用FSO操作文本文件 455
例323 創建文本文件（FSO） 455
例324 添加數據到文本文件（FSO） 456
例325 讀取文本文件數據（FSO） 458
第17章 用Excel控制其他程序技巧
在Excel中，通過VBA代碼可調用其他應用程序的功能。包括創建和打開Word文
檔、創建和打開幻燈片、發送和導入Outlook郵件等。另外，使用VBA提供的Shell函數還可打開Windows中的其他程序、打開控制面板對應的選項等。
17.1 控制Office應用程序 460
例326 打開Word文檔 460
例327 從Word文檔中獲取數據 462
例328 生成成績通知書 464
例329 在Excel中打開PPT 469
例330 在Excel中創建PPT 470
例331 使用SendMail發送郵件 473
例332 用Outlook發送郵件 474
例333 導入Outlook中的郵件 476
例334 保存Outlook中的附件 478
17.2 調用其他程序 479
例335 運行系統自帶程序 479
例336 在Excel中打開控制面板 481
第18章 VBE工程實用操作技巧
在第2章中介紹了VBE的使用方法。其實，VBE也包含一個對象模型，通過該對象模型可控制VBA工程的主要元素。本章實例介紹通過VBE對象模型，用VBA代碼添加或刪除模塊、創建用戶窗體、生成VBA代碼等內容。
18.1 顯示工程相關信息 483
例337 顯示工程信息 483
例338 列出工程所有組件 485
例339 顯示工作簿中VBA的過程名 486
例340 導出VBA過程代碼 488
例341 列出工程引用的外部庫 489
18.2 動態創建組件 490
例342 重命名組件 490
例343 導出/導入模塊代碼 492
例344 刪除指定子過程代碼 494
例345 查找代碼 496
例346 增加模塊 498
例347 增加類模塊 500
例348 控制VBE的子窗口 501
例349 工作表中動態增加按鈕 502
例350 創建動態用戶窗體 504
第19章 VBA程序調試優化技巧
Excel應用程序的順利完成，調試的過程是非常重要的。本章實例介紹Excel VBA調試程序的基本方法和VBA程序的優化技巧。
19.1 VBA程序調試技巧 507
例351 設置斷點 507
例352 使用本地窗口 508
例353 使用立即窗口 510
例354 單步執行 510
例355 運行選定部分代碼 512
例356 調用堆棧 513
例357 使用監視窗口 514
例358 使用條件編譯 515
例359 錯誤處理語句 517
19.2 VBA程序優化技巧 518
例360 使用VBA已有功能 518
例361 避免使用變體 520
例362 使用對象變量 521
例363 使用數組處理單元格 522
例364 檢查字符串是否為空 522
例365 優化循環體 523
例366 使用For Each循環 525
例367 關閉屏幕刷新 526
例368 使用內置函數 527
VBA應用程序由一系列的VBA代碼組成，這些代碼將按照一定的順序執行。有時程序根據一定的條件只能執行某一部分代碼，有時需要重復執行某一段代碼。通過程序結構控制代碼來完成這些功能，本章介紹這些程序控制流程方面的技巧。
3.1 常用輸入/輸出語句
結構化程序設計中使用的基本控制結構有3種：順序結構、選擇結構和循環結構。順序結構就是按照語句的書寫順序從上到下、逐條語句地執行。執行時，編寫在前面的代碼先執行，編寫在后面的代碼后執行。這是最普遍的結構形式，也是后面兩種結構的基礎。
順序結構不需要使用結構控制語句，本節介紹常用的輸入輸出語句的技巧。
例017 九九乘法表（Print方法的應用）
1．案例說明
在早期的Basic版本中，程序運行結果主要依靠Print語句輸出到終端。在VB中，Print作為窗體的一個方法，用來在窗體中顯示信息。但是在VBA中，用戶窗體已經不支持Print方法了。
在VBA中，Print方法只能向“立即窗口”中輸出程序的運行中間結果，供開發人員調試程序時使用。
本例使用Print方法在立即窗口中輸入九九乘法表。
2．關鍵技術
在VBA中，Print方法只能應用于Debug對象，其語法格式如下：
Debug.Print [outputlist]
參數outputlist是要打印的表達式或表達式的列表。如果省略，則打印一個空白行。
— Print首先計算表達式的值，然后輸出計算的結果。在outputlist參數中還可以使用分隔符，以格式化輸出的數據。格式化分隔符有以下幾種：
— Spc(n)：插入n個空格到輸出數據之間；
— Tab(n)：移動光標到適當位置，n為移動的列數；
— 分號：表示前后兩個數據項連在一起輸出；
— 逗號：以14個字符為一個輸出區，每個數據輸出到對應的輸出區。
3．編寫代碼
（1）在VBE中，單擊菜單“插入/模塊”命令插入一個模塊。
（2）在模塊中輸入以下代碼：
Sub multi()
For i = 1 To 9
For j = 1 To i
Debug.Print i; "x"; j; "="; i * j; " ";
Next
Debug.Print '換行
Next
End Sub
（3）按功能鍵“F5”運行子過程，在“立即窗口”輸出九九乘法表，如圖3-1所示。
圖3-1 立即窗口
例018 輸入個人信息（Inputbox函數的應用）
1．案例說明
本例演示Inputbox函數的使用方法。執行程序，將彈出“輸入個人信息”對話框，要求用戶輸入“姓名、年齡、地址”信息，然后在“立即窗口”中將這些信息打印輸出。
2．關鍵技術
為了實現數據輸入，VBA提供了InputBox函數。該函數將打開一個對話框作為輸入數據的界面，等待用戶輸入數據，并返回所輸入的內容。其語法格式如下：
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
各參數的含義如下：
— Prompt：為對話框消息出現的字符串表達式。其最大長度為1024個字符。如果需要在對話框中顯示多行數據，則可在各行之間用回車符換行符來分隔，一般使用VBA的常數vbCrLf代表回車換行符。
— Title：為對話框標題欄中的字符串。如果省略該參數，則把應用程序名放入標題欄中。
— Default：為顯示在文本框中的字符串。如果省略該參數，則文本框為空。
— Xpos：應和Ypos成對出現，指定對話框的左邊與屏幕左邊的水平距離。如果省略該參數，則對話框會在水平方向居中。
— Ypos：應和Xpos成對出現，指定對話框的上邊與屏幕上邊的距離。如果省略該參數，則對話框被放置在屏幕垂直方向距下邊大約三分之一的位置。
— Helpfile：設置對話框的幫助文件，可省略。
— Context：設置對話框的幫助主題編號，可省略。
3．編寫代碼
（1）在VBE中，單擊菜單“插入/模塊”命令插入一個模塊。
（2）在模塊中輸入以下代碼：
Sub inputinfo()
Title = "輸入個人信息"
name1 = "請輸入姓名："
age1 = "請輸入年齡："
address1 = "請輸入地址："
strName = InputBox(name1, Title)
age = InputBox(age1, Title)
Address = InputBox(addres1, Title)
Debug.Print "姓名："; strName
Debug.Print "年齡："; age
Debug.Print "地址："; Address
End Sub
（3）按功能鍵“F5”運行子過程，將彈出“輸入個人信息”窗口，如圖3-2所示。在對話框中輸入內容后按“回車”，或單擊“確定”按鈕。
（4）接著輸入“年齡”和“地址”信息，在“立即窗口”中將輸出這些內容，如圖3-3所示。
圖3-2 輸入個人信息 圖3-3 輸出結果
例019 退出確認（Msgbox函數的應用）
1．案例說明
在應用程序中，有時用戶會由于誤操作關閉Excel，為了防止這種情況，可在退出Excel之前彈出對話框，讓用戶確認是否真的要關閉Excel。
本例使用Msgbox函數彈出對話框，讓用戶選擇是否退出系統。
2．關鍵技術
使用MsgBox函數可打開一個對話框，在對話框中顯示一個提示信息，并讓用戶單擊對話框中的按鈕，使程序繼續執行。
MsgBox函數語法格式如下：
Value=MsgBox(prompt[,buttons][,title][ ,helpfile,context])
通過函數返回值可獲得用戶單擊的按鈕，并可根據按鈕的不同而選擇不同的程序段來執行。
該函數共有5個參數，除第1個參數外，其余參數都可省略。各參數的意義與Inputbox函數參數的意義基本相同，不同的地方是多了一個buttons參數，用來指定顯示按鈕的數目及形式、使用提示圖標樣式、默認按鈕以及消息框的強制響應等。其常數值如表3-1所示。
表3-1 按鈕常數值
常 量
值
說 明
vbOkOnly
0
只顯示“確定”（Ok）按鈕
vbOkCancel
1
顯示“確定”（Ok）及“取消”（Cancel）按鈕
vbAbortRetryIgnore
2
顯示“異常終止”（Abort）、“重試”（Retry）及“忽略”（Ignore）按鈕
vbYesNoCancel
3
顯示“是”（Yes）、“否”（No）及“取消”（Cancel）按鈕
續表
常 量
值
說 明
vbYesNo
4
顯示“是”（Yes）及“否”（No）按鈕
vbRetryCancel
5
顯示“重試”（Retry）及“取消”（Cancel）按鈕
vbCritical
16
顯示Critical Message圖標
vbQuestion
32
顯示Warning Query圖標
vbExclamation
48
顯示Warning Message圖標
vbInformation
64
顯示Information Message圖標
vbDefaultButton1
0
以第一個按鈕為默認按鈕
vbDefaultButton2
256
以第二個按鈕為默認按鈕
vbDefaultButton3
512
以第三個按鈕為默認按鈕
vbDefaultButton4
768
以第四個按鈕為默認按鈕
vbApplicationModal
0
進入該消息框，當前應用程序暫停
vbSystemModal
4096
進入該消息框，所有應用程序暫停
表3-1中的數值（或常數）可分為四組，其作用分別為：
— 第一組值（0～5）用來決定對話框中按鈕的類型與數量。
— 第二組值（16，32，48，64）用來決定對話框中顯示的圖標。
— 第三組值（0，256，512）設置對話框的默認活動按鈕。活動按鈕中文字的周轉有虛線，按回車鍵可執行該按鈕的單擊事件代碼。
— 第四組值（0，4096）決定消息框的強制響應性。
buttons參數可由上面4組數值組成，其組成原則是：從每一類中選擇一個值，把這幾個值累加在一起就是buttons參數的值（大部分時間里都只使用前三組數值的組合），不同的組合可得到不同的結果。
3．編寫代碼
（1）在VBE中，雙擊“工程”子窗口中的“ThisWorkbook”打開代碼窗口，如圖3-4所示。
（2）在代碼窗口左上方的對象列表中選擇“Workbook”，如圖3-5所示。
（3）在代碼窗口右上方的事件列表中選擇“BeforeClose”，如圖3-6所示。代碼窗口中將自動生成事件過程結構如下：
圖3-5 對象列表 圖3-6 事件列表
Private Sub Workbook_BeforeClose(Cancel As Boolean)
End Sub
（4）在上面生成的事件過程中輸入以下代碼：
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim intReturn As Integer
intReturn = MsgBox("真的退出系統嗎？", vbYesNo + vbQuestion, "提示")
If intReturn <> vbYes Then Cancel = True
End Sub
（5）保存Excel工作簿。
（6）關閉Excel工作簿時，將彈出如圖3-7所示的對話框。單擊“是”按鈕將退出Excel，單擊“否”按鈕將返回Excel工作簿。
3.2 分支結構
分支結構，又叫選擇結構。這種結構的程序將根據給定的條件來決定執行哪一部分代碼，而跳過其他代碼。
例020 突出顯示不及格學生
1．案例說明
本例判斷學生成績表中的成績，如果成績不及格（低于60分），則將該成績著重顯示出來。如圖3-8所示（左圖為原成績，右圖突出顯示不及格成績）。
圖3-8 突出顯示不及格學生
2．關鍵技術
在本例中，需要進行一個判斷（成績是否低于60分），這時可使用If…Then語句。用If…Then語句可有條件地執行一個或多個語句。其語法格式如下：
If 邏輯表達式 Then
語句1
語句1
… …
語句n
End If
邏輯表達式也可以是任何計算數值的表達式，VBA將為零（0）的數值看做False，而任何非零數值都被看做True。
該語句的功能為：若邏輯表達式的值是True，則執行位于Then與End If之間的語句；若邏輯表達式的值是False，則不執行Then與End If之間的語句，而執行End If后面的語句。其流程圖如圖3-9所示。
If…Then結構還有一種更簡單的形式：單行結構條件語句。其語法格式如下：
If 邏輯表達式 Then 語句
該語句的功能為：若邏輯表達式的值是True，則執行Then后的語句；若邏輯表達式的值是False，則不執行Then后的語句，而執行下一條語句。
3．編寫代碼
（1）打開“學生成績表”。
（2）按快捷鍵“Alt+F11”進入VBE環境。
（3）單擊菜單“插入/模塊”命令向工程中插入一個模塊，并編寫以下代碼：
Sub 顯示不及格學生()
Dim i As Integer
For i = 3 To 11
If Sheets(1).Cells(i, 2).Value < 60 Then
Sheets(1).Cells(i, 2).Select
Selection.Font.FontStyle = "加粗"
Selection.Font.ColorIndex = 3
End If
Next
End Sub
（4）關閉VBE開發環境返回Excel。
（5）在功能區“開發工具”選項卡的“控件”組中，單擊“插入”按鈕彈出“表單控件”面板，如圖3-10所示。
圖3-10 插入按鈕
（6）在“表單控件”面板中單擊“按鈕”，拖動鼠標在工作表中繪制一個按鈕。當松開鼠標時，將彈出“指定宏”對話框，如圖3-11所示。
（7）在“指定宏”對話框中，單擊選中“顯示不及格學生”宏，單擊“確定”按鈕。
（8）右擊工作表中的按鈕，彈出快捷菜單如圖3-12所示，單擊“編輯文字”菜單，修改按鈕中的提示文字為“顯示不及格學生”。
圖3-11 指定宏 圖3-12 編輯文字
（9）單擊“顯示不及格學生”按鈕，執行宏代碼，成績表中不及格成績將突出顯示為粗體、紅色，如圖3-13所示。
圖3-13 執行程序
例021 從身份證號碼中提取性別
1．案例說明
在很多信息系統中都需要使用到身份證號碼，身份證號碼中包含有很多信息，如可從其中提取性別。我國現行使用的身份證號碼有兩種編碼規則，即15位居民身份證和18位居民身份證。
15位的身份證號的編碼規則。
dddddd yymmdd xx p
18位的身份證號的編碼規則。
dddddd yyyymmdd xx p y
其中：
— dddddd為地址碼（省地縣三級）18位中的和15位中的不完全相同。
— yyyymmdd yymmdd 為出生年月日。
— xx序號類編碼。
— p性別。
— 18位中末尾的y為校驗碼。
2．關鍵技術
在If…Then語句中，條件不成立時不執行任何語句。在很多時候需要根據條件是否成立分別執行兩段不同的代碼，這時可用If…Then…Else語句，其語法格式如下：
If 邏輯表達式 Then
語句序列1
Else
語句序列2
End If
VBA判斷“邏輯表達式”的值，如果它為True，將執行“語句序列1”中的各條語句，當“邏輯表達式”的值為False時，就執行“語句序列2”中的各條語句。其流程圖如圖3-14所示。
3．編寫代碼
（1）新建Excel工作簿，在VBE中插入一個模塊。
（2）在模塊中編寫以下代碼：
Sub 根據身份證號碼確定性別()
sid = InputBox("請輸入身份證號碼：")
i = Len(sid)
If i <> 15 And i <> 18 Then '判斷身份證號長度是否正確
MsgBox "身份證號碼只能為15位或18位！"
Exit Sub
End If
If i = 15 Then '長度為15位
s = Right(sid, 1) '取最右側的數字
Else '長度為18度
s = Mid(sid, 17, 1) '取倒數第2位數
End If
If Int(s / 2) = s / 2 Then '為偶數
sex = "女"
Else
sex = "男"
End If
MsgBox "性別：" + sex
End Sub
（3）切換到Excel環境，添加一個按鈕“從身份證號碼提取性別”，并指定執行上步創建的宏。
（4）單擊“從身份證號碼提取性別”按鈕，彈出如圖3-15所示對話框。
（5）輸入身份證號碼后單擊“確定”按鈕，將在如圖3-16所示對話框中顯示性別。
圖3-15 輸入身份證號碼 圖3-16 顯示性別
例022 評定成績等級
1．案例說明
本例將成績表中的百分制成績按一定規則劃分為A、B、C、D、E五個等級，如圖3-17所示。
圖3-17 評定成績等級
其中各等級對應的成績分別為：
— A：大于等于90分；
— B：大于等于80分，小于90分；
— C：大于等于70分，小于80分；
— D：大于等于60分，小于70分；
— E：小于60分。
2．關鍵技術
本例共有五個分支，使用If…Then…Else這種二路分支結構也可完成，但需要復雜的嵌套結構才能解決該問題。其實VBA中提供了一種If…Then…ElseIf的多分支結構，其語法格式如下：
If 邏輯表達式1 Then
語句序列1
ElseIf 邏輯表達式2 Then
語句序列2.
ElseIf 邏輯表達式3 Then
語句序列3
... …
Else
語句序列n
End If
在以上結構中，可以包括任意數量的ElseIf子句和條件，ElseIf子句總是出現在Else子句之前。
VBA首先判斷“邏輯表達式1”的值。如果它為False，再判斷“邏輯表達式2”的值，依此類推，當找到一個為True的條件，就會執行相應的語句塊，然后執行End If后面的代碼。如果所有“邏輯表達式”都為False，且包含Else語句塊，則執行Else語句塊。其流程圖如圖3-18所示。
圖3-18 If…Then…ElseIf語句流程圖
3．編寫代碼
（1）在Excel中打開成績表。
（2）按快捷鍵“Alt+F11”進入VBE開發環境。
（3）單擊“插入/模塊”命令向工程中插入一個模塊，并編寫以下VBA代碼：
Sub 評定等級()
Dim i As Integer
For i = 3 To 11
t = Sheets(1).Cells(i, 2).Value '取得成績
If t >= 90 Then
j = "A"
ElseIf t >= 80 Then
j = "B"
ElseIf t >= 70 Then
j = "C"
ElseIf t >= 60 Then
j = "D"
Else
j = "E"
End If
Sheets(1).Cells(i, 3) = j
Next
End Sub
（4）返回Excel操作界面，在成績表旁邊增加一個按鈕，并指定執行宏“評定等級”。
（5）單擊“評定等級”按鈕，即可在成績表的C列顯示出各成績對應的等級，如圖3-17所示。
例023 計算個人所得稅
1．案例說明
在工資管理系統中，需要計算員工應繳納的個人所得稅。個人所得稅稅額按5%至45%的九級超額累進稅率計算應繳稅額，稅率表如圖3-19所示。
個人所得稅的計算公式為：
應納個人所得稅稅額=應納稅所得額×適用稅率-速算扣除數
本例根據工資表中的相應數據計算出納稅額，并填充在工資表對應的列中。
圖3-19 個人所得稅稅率表
2．關鍵技術
本例中計算個人所得稅時共有九個分支。這時可在If…Then…ElseIf結構中添加多個ElseIf塊來進行各分支的處理。對于多分支結構，可使用Select Case語句。Select Case語句的功能與If…Then…Else語句類似，但在多分支結構中，使用Select Case語句可使代碼簡潔易讀。
Select Case結構的語法格式如下：
Select Case 測試表達式
Case 表達式列表1
語句序列1
Case 表達式列表2
語句序列2
… …
Case Else
語句序列n
End Select
在以上結構中，首先計算出“測試表達式”的值，然后，VBA將表達式的值與結構中的每個Case的值進行比較。如果相等，就執行與該Case語句下面的語句塊，執行完畢再跳轉到End Select語句后執行。其流程圖如圖3-20所示。
圖3-20 Select Case語句流程圖
在Select Case結構中，“測試表達式”通常是一個數值型或字符型的變量。“表達式列表”可以是一個或幾個值的列表。如果在一個列表中有多個值，需要用逗號將各值分隔開。表達式列表可以按以下幾種情況進行書寫：
— 表達式：表示一些具體的取值。例如：Case 10,15,25。
— 表達式A To 表達式B：表示一個數據范圍。例如，Case 7 To 17表示7～17之間的值。
— Is 比較運算符表達式：表示一個范圍。例如，Case Is>60 表示所有大于90的值。
— 以上三種情況的混合。例如，Case 4 To 10, 15, Is>20。
3．編寫代碼
（1）在Excel中打開工資表工作簿。
（2）按快捷鍵“Alt+F11”進入VBE開發環境。
（3）單擊菜單“插入/模塊”命令插入一個模塊。
（4）在模塊中編寫以下函數，用來計算所得稅：
Function 個人所得稅(curP As Currency)
Dim curT As Currency
curP = curP – 1600 '1600為扣除數
If curP > 0 Then
Select Case curP
Case Is <= 500
curT = curP * 0.05
Case Is <= 2000
curT = (curP - 500) * 0.1 + 25
Case Is <= 5000
curT = (curP - 2000) * 0.15 + 125
Case Is <= 20000
curT = (curP - 5000) * 0.2 + 375
Case Is <= 40000
curT = (curP - 20000) * 0.25 + 1375
Case Is < 60000
curT = (curP - 40000) * 0.3 + 3375
Case Is < 80000
curT = (curP - 60000) * 0.35 + 6375
Case Is < 100000
curT = (curP - 80000) * 0.4 + 10375
Case Else
curT = (curP - 100000) * 0.45 + 15375
End Select
個人所得稅 = curT
Else
個人所得稅 = 0
End If
End Function
（5）在模塊中編寫“計算”子過程，計算工資表中每個員工應繳所得稅額，并填寫在對應的列中。
Sub 計算()
For i = 4 To 9
Sheets(1).Cells(i, 8).Value = 個人所得稅(Sheets(1).Cells(i, 6).Value)
Next
End Sub
（6）返回到Excel環境中，在工資表下方插入一個按鈕，為按鈕指定宏為“計算”。
（7）單擊“計算”按鈕，可計算出每個員工的所得稅額，如圖3-21所示。
圖3-21 計算所得稅
3.3 循環結構
在實際開發的應用系統中，經常需要重復執行一條或多條語句。這種結構稱為循環結構。循環結構的思想是利用計算機高速處理運算的特性，重復執行某一部分代碼，以完成大量有規則的重復性運算。
VBA提供了多個循環結構控制語句：Do…Loop結構、While…Wend結構、For…Next結構、For Each…Next結構。
例024 密碼驗證
1．案例說明
在信息管理系統中，很多時候都需要用戶進行登錄操作。在登錄操作時要求用戶輸入密碼，一般都要給用戶三次機會，每次的輸入過程和判斷過程都相同。
本例使用Do…Loop循環完成密碼驗證過程。
2．關鍵技術
在VBA中，最常用的循環語句是Do…Loop循環。循環結構Do While…Loop的語法格式如下：
Do While 邏輯表達式
語句序列1
[Exit Do]
[語句序列2]
Loop
其中Do While和Loop為關鍵字，在Do While和Loop之間的語句稱為循環體。
當VBA執行這個Do循環時，首先判斷“邏輯表達式”的值，如果為False（或零），則跳過所有語句，執行Loop的下一條語句，如果為True（或非零），則執行循環體，當執行到Loop語句后，又跳回到Do While語句再次判斷條件。在循環體中如果包含有Exit Do語句，當執行到Exit Do語句，馬上跳出循環，執行Loop的下一條語句。其流程圖如圖3-22所示。
圖3-22 Do While…Loop流程圖
VBA的Do…Loop循環有4種結構，分別如下：
— Do While…Loop循環：先測試條件，如果條件成立則執行循環體。
— Do…Loop While循環：先執行一遍循環體，再測試循環條件，如果條件成立則執行循環體。
— Do Until…Loop循環：先測試條件，如果條件不成立則執行循環體。
— Do…Loop Until循環：先執行一遍循環體，再測試循環條件，如果條件不成立則執行循環體。
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE開發環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）在模塊中編寫以下VBA代碼：
Sub login()
Dim strPassword As String '保存密碼
Dim i As Integer '輸入密碼的次數
Do
strPassword = InputBox("請輸入密碼") '輸入密碼
If strPassword = "test" Then '判斷密碼是否正確
Exit Do '退出循環
Else
MsgBox ("請輸入正確的密碼！")
End If
i = i + 1
Loop While i < 3
If i >= 3 Then '超過正常輸入密碼次數
MsgBox "非法用戶，系統將退出！"
Application.Quit
Else
MsgBox "歡迎你使用本系統！"
End If
End Sub
（4）返回Excel操作界面，在工作表中插入一個按鈕，設置提示文字為“密碼驗證”，并為該按鈕指定執行的宏為“login”。
（5）單擊“密碼驗證”按鈕，彈出如圖3-23所示對話框，輸入密碼后單擊“確定”按鈕進行密碼的驗證。
例025 求最小公倍數和最大公約數
1．案例說明
幾個數公有的倍數叫做這幾個數的公倍數，其中最小的一個叫做這幾個數的最小公倍數。如12、18、20這三個數的最小公倍數為180。
最大公約數是指某幾個整數的共有公約數中最大的那個數。如2、4、6這三個數的最大公約數為2。
本例使用輾轉相除法求兩個自然數m、n的最大公約數和最小公倍數。
2．關鍵技術
本例首先求出兩數m、n的最大公約數，再將m、n數的乘積除以最大公約數，即可得到最小公倍數。求最大公約數的算法流程圖如圖3-24所示。
圖3-24 最大公約數算法流程圖
本例使用Do…Loop循環，并且沒有設置循環條件。一般情況下，這種循環是一個死循環（也就是說程序將一直循環下去），因此，在這種循環結構中必須添加一個判斷語句，當達到指定的條件時退出循環。如本例中使用以下語句退出循環：
If r = 0 Then Exit Do
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）在模塊中編寫以下子過程：
Sub 最小公倍數和最大公約數()
Dim m As Integer, n As Integer
Dim m1 As Integer, n1 As Integer
Dim t As Integer
m = InputBox("輸入自然數m：")
n = InputBox("輸入自然數n：")
m1 = m
n1 = n
If m1 < n1 Then
m1 = n
n1 = m '交換m和n的值
End If
Do
r = m1 Mod n1
If r = 0 Then Exit Do
m1 = n1
n1 = r
Loop
str1 = m & "," & n & "的最大公約數=" & n1 & vbCrLf
str1 = str1 & "最小公倍數=" & m * n / n1
MsgBox str1
End Sub
（4）返回Excel操作環境，向工作表中插入一個按鈕，為按鈕指定執行上步創建的宏。
（5）單擊按鈕，彈出如圖3-25所示的輸入提示框，分別輸入兩個數后，得到如圖3-26所示的結果。
圖3-25 輸入數據 圖3-26 最大公約數和最小公倍數
例026 輸出ASCII碼表
1．案例說明
目前計算機中用得最廣泛的字符集及其編碼，是由美國國家標準局（ANSI）制定的ASCII碼。ASCII碼由8位二進制組成，一共可包含256個符號。本例使用循環語句輸出ASCII中的可見字符，如圖3-27所示。
圖3-27 ASCII碼表
2．關鍵技術
使用Do…Loop循環時，可以不知道循環的具體次數。如果知道循環的次數，可以使用For…Next循環語句來執行循環。For循環的語法如下：
For 循環變量=初始值 To 終值 [Step 步長值]
語句序列1
[Exit For]
[語句序列2]
Next [循環變量]
在For循環中使用循環變量來控制循環，每重復一次循環之后，循環變量的值將與步長值相加。步長值可正可負，如果步長值為正，則初始值必須小于等于終值，才執行循環體，否則退出循環。如果步長值為負，則初始值必須大于等于終值，這樣才能執行循環體。如果沒有設置Step，則步長值默認為1。For…Next循環結構的流程圖如圖3-28所示。
For循環一般都可計算出循環體的執行次數，計算公式如下：
循環次數=[(終值-初值)/步長值]+1
這里用中括號表示取整。
在事先不知道循環體需要執行多少次時，應該用Do循環。而在知道循環體要執行的次數時，最好使用For…Next循環。
圖3-28 For…Next流程圖
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）在模塊中編寫以下子過程：
Sub ascii()
Dim a As Integer, i As Integer
i = 3
For a = 32 To 126
Sheets(1).Cells(i, 1) = a
Sheets(1).Cells(i, 2) = Chr(a)
i = i + 1
Next
End Sub
（4）返回Excel操作環境，向工作表中插入一個按鈕，為按鈕指定執行上步創建的宏。
（5）單擊按鈕，得到如圖3-27所示的結果。
例027 計算選中區域數值之和
1．案例說明
在某些情況下，需要統計工作表中選定區域數值單元格的數值之和（例如，臨時查看應發獎金之和），在Excel的狀態欄就可查看選中單元格的數值之和。本例編寫VBA代碼，使用循環結構來完成該項功能。
2．關鍵技術
用戶在Excel工作表中選定單元格的數量是不固定的，若需統計所選單元格數值之和，這時可使用For Each循環來進行處理，對選中區域的每個單元格進行判斷，然后再累加數值單元格的值。
For Each…Next循環語句的語法格式如下：
For Each 元素 In 對象集合
[語句序列1]
[Exit For]
[語句序列2]
Next
使用For Each循環結構，可在對象集合每個元素中執行一次循環體。如果集合中至少有一個元素，就會進入For Each循環體執行。一旦進入循環，便先針對“對象集合”中第一個元素執行循環中的所有語句。如果“對象集合”中還有其他的元素，則會針對它們執行循環中的語句，當“對象集合”中的所有元素都執行完了，便會退出循環，然后從Next語句之后的語句繼續執行。
在循環體中可以放置任意多個Exit For語句，隨時退出循環。Exit For經常在條件判斷之后使用，例如If…Then，并將控制權轉移到緊接在Next之后的語句。
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）在模塊中編寫以下子過程：
Sub 求和()
Dim r
Dim t As Long
For Each r In Selection
If IsNumeric(r.Value) Then
t = t + r.Value
End If
Next
MsgBox "所選區域數值之和為：" & t
End Sub
（4）返回Excel操作環境，向工作表中插入一個按鈕，修改按鈕的提示字符為“求和”，為按鈕指定執行上步創建的宏“求和”。
（5）在工作表“Sheet1”中輸入數據，如圖3-29左圖所示。
（6）拖動鼠標選中如圖3-29左圖所示數據區域，單擊“求和”按鈕，求和結果將顯示在如圖3-29右圖所示對話框中。
圖3-29 計算選中區域數值之和
例028 換零錢法（多重循環）
1．案例說明
將十元錢換成1角、2角、5角、1元、2元、5元的零錢若干，求出一共有多少種方法進行計算？
2．關鍵技術
在VBA中，循環結構內的循環體又可以是循環結構，這種情況稱為循環的嵌套。VBA允許在同一過程里嵌套多種類型的循環。
在編寫嵌套循環程序的代碼時，一定要注意每個循環語句的配對情況。如圖3-30所示，其中左圖是正確的嵌套關系，第一個Next關閉了內層的For循環，而最后一個Loop關閉了外層的Do循環。同樣，在嵌套的If語句中，End If語句自動與最靠近的前一個If語句配對。嵌套的Do…Loop結構的工作方式也是一樣的，最內圈的Loop語句與最內圈的Do語句匹配。圖3-30右圖則是錯誤的嵌套關系。
語句序列2
圖3-30 正確的嵌套（左）與錯誤的嵌套（右）
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）零錢換法最簡單的算法是：使用多重循環，將10元錢能換成的各種可能都考慮進去（如10可換為100個1角，可換為50個2角，等等）。根據這種算法在模塊中編寫以下子過程：
Sub 換零錢1()
Dim t As Integer
For i = 0 To 100 '1角
For j = 0 To 50 '2角
For k = 0 To 20 '5角
For l = 0 To 10 '1元
For m = 0 To 5 '2元
For n = 0 To 2 '5元
If i + 2 * j + 5 * k + 10 * l + 20 * m + 50 * n = 100 Then
t = t + 1
Sheets(1).Cells(t + 1, 1) = i
Sheets(1).Cells(t + 1, 2) = j
Sheets(1).Cells(t + 1, 3) = k
Sheets(1).Cells(t + 1, 4) = l
Sheets(1).Cells(t + 1, 5) = m
Sheets(1).Cells(t + 1, 6) = n
End If
Next
Next
Next
Next
Next
Next
MsgBox "10元換為零錢共有" & t & "種方法！"
End Sub
（4）運行該子過程，Excel工作表中每一行將填寫一種可能的換法，如圖3-31所示。
（5）因為換零錢的方法很多，根據計算機的速度不同該程序的運行速度也不同，最后將通過對話框顯示出總的換法次數，如圖3-32所示。
圖3-31 零錢換法 圖3-32 換法總數
（6）在循環嵌套中，內層循環體執行的次數等各外層循環數數之積，如本例代碼內循環執行次數為：
101×51×21×11×6×3=21417858次
（7）對于嵌套循環，一般都可以對代碼進行一定的優化，使程序的執行效率更高。本例最簡單的優化代碼如下：
Sub 換零錢2()
Dim t As Long
For j = 0 To 50 '2角
For k = 0 To 20 '5角
For l = 0 To 10 '1元
For m = 0 To 5 '2元
For n = 0 To 2 '5元
t2 = 2 * j + 5 * k + 10 * l + 20 * m + 50 * n
If t2 <= 100 Then
t = t + 1
i = 100 - t2
Sheets(1).Cells(t + 1, 1) = i
Sheets(1).Cells(t + 1, 2) = j
Sheets(1).Cells(t + 1, 3) = k
Sheets(1).Cells(t + 1, 4) = l
Sheets(1).Cells(t + 1, 5) = m
Sheets(1).Cells(t + 1, 6) = n
End If
Next
Next
Next
Next
Next
MsgBox "10元換為零錢共有" & t & "種方法！"
End Sub
（8）以上程序中內循環的執行數數如下：
51×21×11×6×3=212058次
可以看出減少最外層循環的101次，可使用內循環體提高100倍的執行效率。
本例程序還有很多優化方法，這里就不再介紹。
3.4 使用數組
在程序中，如果要處理大量的數據，為每個數據定義一個變量將使程序變得很難閱讀，并且代碼很煩瑣。
對于大量有序的數據，可以使用數組對其進行存儲和處理。在其他程序設計語言中，數組中的所有元素都必須為同樣的數據類型，在VBA中，數組中各元素可以是相同的數據類型，也可以是不同的數據類型。
例029 數據排序
1．案例說明
在Excel中可以方便地對單元格區域中的數據進行排序。本例使用VBA程序首先讓用戶輸入10個數據，然后使用冒泡排序法對這10個數進行排序。
2．關鍵技術
在程序中處理大量數據時，使用數組來保存是比較好的方法。數組使用之前可以使用Dim、Static、Private或Public語句來聲明。在VBA中，數組最大可以達到60維，最常用的是一維數組和二維數組。
定義一維數組的語法格式如下：
Dim 數組名([下界 To] 上界) As 數據類型
其中“下界”可以省略，只給出數組的上界（即可以使用的最大下標值），這時默認值為0，即數組的下標從0開始至定義的上界，如：
Dim MyArray(10) As String
定義了一個名為MyArray的數組，共有11個元素，分別為MyArray(0)、MyArray(1)、…、MyArray(10)。
如果希望下標從1開始，可以通過Option Base語句來設置，其語法格式如下：
Option Base 1
使用該語句指定數組下標的默認下界，只能設為0或1。
—
該語句只能出現在用戶窗體或模塊的聲明部分，不能出現在過程中，且必須放在數組定義之前。
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）在模塊中編寫以下代碼：
Option Base 1
Sub 數據排序()
Dim i As Integer, j As Integer
Dim k
Dim s(10) As Integer
For i = 1 To 10
s(i) = Application.InputBox("輸入第" & i & "個數據：", "輸入數組", , , , , , 1)
Next
For i = 1 To 9
For j = i + 1 To 10
If s(i) < s(j) Then
t = s(i)
s(i) = s(j)
s(j) = t
End If
Next
Next
For Each k In s
Debug.Print k
Next
End Sub
在VBA中使用Inputbox函數接受用戶輸入數據時，返回的值為文本型。以上代碼中使用了Application對象的InputBox方法來接受用戶輸入數據，該方法的語法格式如下：
Application.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextID, Type)
設置Type參數可指定返回的數據類型，如本例設置其值為2，則返回的值為數值型。
（4）運行上面的宏，彈出如圖3-33所示的對話框，提示用戶輸入數據。循環程序要求用戶輸入10個數據。
（5）最后在“立即窗口”輸出排序的結果，如圖3-34所示。
圖3-33 輸入數據 圖3-34 排序結果
例030 彩票幸運號碼
1．案例說明
本例結合數組和隨機函數的知識，生成指定數量的彩票幸運號碼。本例生成的彩票號碼每注由7位數構成，首先讓用戶輸入產生的注數，再使用循環語句生成指定注數的號碼。
2．關鍵技術
本例代碼中使用了兩個關鍵技術：動態數組和隨機函數。
（1）動態數組
本例使用二維數組保存所有的彩票號碼，二維數組的定義格式如下：
Dim 數組名(第1維上界, 第2維上界) As 數據類型
或
Dim 數組名(第1維下界 To 第1維上界, 第2維下界 To 第2維上界) As 數據類型
在本例中，因為生成的彩票數量是由用戶輸入的數據決定的。因此這里使用動態數組。
動態數組是指在程序運行時大小可以改變的數組，定義動態數組一般分兩個步驟：首先在用戶窗體、模塊或過程中使用Dim或Public聲明一個沒有下標的數組（不能省略括號），然后在過程中用ReDim語句重定義該數組的大小。
ReDim語句在過程級別中使用，用于為動態數組變量重新分配存儲空間。其語法格式如下：
ReDim [Preserve] 數組名(下標) [As 數據類型]
可以使用ReDim語句反復地改變數組的元素以及維數的數目，但是不能在將一個數組定義為某種數據類型之后，再使用ReDim將該數組改為其他數據類型，除非是Variant所包含的數組。
在默認情況下，使用ReDim語句重定義數組的維數和大小時，數組中原來保存的值將全部消失，如果使用Preserve關鍵字，當改變原有數組最后一維的大小時，可以保持數組中原來的數據。
如果使用了Preserve關鍵字，就只能重新定義數組最后一維的大小，并不能改變維數的數目。
（2）隨機函數Rnd
隨機函數Rnd可返回小于1但大于或等于0的一個小數。其語法格式如下：
Rnd[(number)]
可選的number參數是Single或任何有效的數值表達式。根據number參數值的不同，Rnd函數生成的隨機數也不同：
— number<0，則每次使用相同的number作為隨機數種得到的相同結果。
— number>0，則將生成隨機序列中的下一個隨機數。
— number=0，則將生成最近生成的數。
— 省略number，則生成序列中的下一個隨機數。
—
在調用Rnd之前，先使用無參數的Randomize語句初始化隨機數生成器，該生成器具有根據系統計時器得到的種子。
為了生成某個范圍內的隨機整數，可使用以下公式：
Int((上限 – 下限 + 1) * Rnd + 下限)
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）在模塊中編寫以下代碼：
Option Base 1
Sub 幸運號碼()
Dim n As Integer, i As Integer, j As Integer
Dim l() As Integer
n = Application.InputBox("請輸入需要產生幸運號碼的數量：", "幸運號碼", , , , , , 2)
ReDim l(n, 7) As Integer
For i = 1 To n
For j = 1 To 7
Randomize
l(i, j) = Int(10 * Rnd)
Next
Next
For i = 1 To n
For j = 1 To 7
Debug.Print l(i, j);
Next
Debug.Print
Next
End Sub
（4）運行上面的宏，彈出如圖3-35所示的對話框，提示用戶輸入數據。輸入生成幸運號碼的數量。
（5）單擊“確定”按鈕后在“立即窗口”輸出生成的幸運號碼，如圖3-36所示。
圖3-35 輸入數據 圖3-36 生成幸運號碼
例031 用數組填充單元格區域
1．案例說明
在Excel中要處理大量數據時，可使用循環從各單元格讀入數據，經過加工處理后再寫回單元格區域中。這種方式比在數組中處理數據的速度要慢。因此，如果有大量的數據需要處理時，可先將數據保存到數組中，經過加工處理后，再將數組的數據填充到單元格區域。
本例演示將二維數組中的數據填充到工作表中的方法。
2．關鍵技術
在Excel工作表中，工作表是一個二維結構，由行和列組成。這種特性與二維數組類似，因此可以很方便地將工作表單元格區域與二維數組之間進行轉換。通過以下語句可將單元格區域賦值給一個二維數組：
myarr = Range(Cells(1, 1), Cells(5, 5))
反過來，也可將二維數組中的值快速的賦值給一個單元格區域，如以下語句將二維數組myarr中的值賦值給單元格區域Rng：
Rng.Value = arr
3．編寫代碼
（1）新建Excel工作簿，按快捷鍵“Alt+F11”進入VBE環境。
（2）單擊菜單“插入/模塊”命令向工程中插入一個模塊。
（3）在模塊中編寫以下代碼：
Option Base 1
Sub 數組填充單元格區域()
Dim i As Long, j As Long
Dim col As Long, row As Long
Dim arr() As Long
row = Application.InputBox(prompt:="輸入行數：", Type:=2)
col = Application.InputBox(prompt:="輸入列數：", Type:=2)
ReDim arr(row, col)
For i = 1 To row
For j = 1 To col
arr(i, j) = (i - 1) * col + j
Next
Next
Set Rng = Sheets(1).Range(Cells(1, 1), Cells(row, col))
Rng.Value = arr
End Sub
（4）返回Excel操作環境，向工作表中添加一個按鈕，設置提示文字為“填充數據”，指定該按鈕的宏為“數組填充單元格區域”。
（5）單擊“填充數據”按鈕，彈出如圖3-37所示對話框，分別輸入數組的行和列。
圖3-37 輸入行和列
（6）VBA代碼生成一個二維數組，最后填充到工作表中，如圖3-38所示。
圖3-38 填充數據
通過Excel相關對象可對工作表中的數據進行操作，如處理單元格區域的公式、對數據進行查詢、排序、篩選等操作。本章演示使用VBA進行處理數據的實例。
12.1 處理公式
使用VBA代碼可對工作表中的公式單元格進行處理，如判斷單元格是否包含公式、復制公式、將單元格公式轉換為具體的值等。
例254 判斷單元格是否包含公式
1．案例說明
打開本例工作簿如圖12-1所示，單擊左上角的“公式單元格”按鈕，將彈出如圖12-1右圖所示的提示框，顯示當前工作表中定義了公式的單元格。
圖12-1 顯示有公式的單元格
2．關鍵技術
本例使用Range對象的HasFormula屬性來判斷指定單元格是否包含公式，如果區域中所有單元格均包含公式，則該屬性值為True；如果所有單元格均不包含公式，則該屬性值為False；其他情況下為null。
本例對當前單元格區域中的單元格逐個進行判斷，并顯示出具有公式的單元格。
3．編寫代碼
“公式單元格”按鈕的VBA代碼如下：
Sub 顯示公式單元格()
Dim rng As Range
Set rng = ActiveSheet.Range("A1").CurrentRegion
For Each c In rng.Cells
If c.HasFormula Then
MsgBox "單元格" & c.Address & " 定義了公式！"
End If
Next
End Sub
例255 自動填充公式
1．案例說明
打開本例工作簿如圖12-2所示，在如圖所示工作表中，單元格J3和D16定義了公式，單擊“填充公式”按鈕，單元格J3的公式將向下填充，單元格D16的公式向右填充，結果如圖12-3所示。
圖12-2 原工作表
圖12-3 復制公式
2．關鍵技術
本例使用Range對象的AutoFill方法，對指定區域中的單元格執行自動填充。該方法的語法格式如下：
表達式.AutoFill(Destination, Type)
該方法有兩個參數，其含義如下：
— Destination：要填充的單元格。目標區域必須包括源區域。
— Type：指定填充類型。該填充類型可使用xlAutoFillType枚舉類型，其值如表12-1所示。
表12-1 xlAutoFillType枚舉值
名 稱
值
描 述
xlFillCopy
1
將源區域的值和格式復制到目標區域，如有必要可重復執行
xlFillDays
5
將星期中每天的名稱從源區域擴展到目標區域中。格式從源區域復制到目標區域，如有必要可重復執行
xlFillDefault
0
Excel確定用于填充目標區域的值和格式
xlFillFormats
3
只將源區域的格式復制到目標區域，如有必要可重復執行
xlFillMonths
7
將月名稱從源區域擴展到目標區域中。格式從源區域復制到目標區域，如有必要可重復執行
xlFillSeries
2
將源區域中的值擴展到目標區域中，形式為系列（如，“1, 2”擴展為“3, 4, 5”）。格式從源區域復制到目標區域，如有必要可重復執行
xlFillValues
4
只將源區域的值復制到目標區域，如有必要可重復執行
xlFillWeekdays
6
將工作周每天的名稱從源區域擴展到目標區域中。格式從源區域復制到目標區域，如有必要可重復執行
xlFillYears
8
將年從源區域擴展到目標區域中。格式從源區域復制到目標區域，如有必要可重復執行
xlGrowthTrend
10
將數值從源區域擴展到目標區域中，假定源區域的數字之間是乘法關系（如，“1, 2,”擴展為“4, 8, 16”，假定每個數字都是前一個數字乘以某個值的結果）。格式從源區域復制到目標區域，如有必要可重復執行
xlLinearTrend
9
將數值從源區域擴展到目標區域中，假定數字之間是加法關系（如，“1, 2,”擴展為“3, 4, 5”，假定每個數字都是前一個數字加上某個值的結果）。格式從源區域復制到目標區域，如有必要可重復執行
3．編寫代碼
“填充公式”按鈕的VBA代碼如下：
Sub 填充公式()
Dim i As Long, j As Long
With Range("A1").CurrentRegion
i = .Rows.Count - 1
j = .Columns.Count - 1
End With
Range("J3").AutoFill _
Destination:=Range(Cells(3, 10), Cells(i, 10))
Range("D16").AutoFill _
Destination:=Range(Cells(16, 4), Cells(16, j))
End Sub
以上代碼首先獲取當前區域的行和列，接著使用AutoFill方法在垂直方向和水平方向填充相應的公式。
例256 鎖定和隱藏公式
1．案例說明
打開本例工作簿如圖12-4所示，單擊“鎖定隱藏公式”按鈕，當前工作表中的所有公式單元格將被鎖定，不允許用戶修改，而其他單元格的數據用戶可進行修改。同時，公式單元格定義的公式將被隱藏，單擊選取具有公式的單元格時，將不會顯示公式。
圖12-4 鎖定和隱藏公式
2．關鍵技術
要鎖定和隱藏單元格，可通過Range對象的以下兩個屬性來進行設置。
— Locked屬性：指明對象是否已被鎖定。
— FormulaHidden屬性：指明在工作表處于保護狀態時是否隱藏公式。
當設置以上兩個屬性為True時，對指定區域鎖定和隱藏。但要真正鎖定和隱藏單元格，必須使用Protect方法對工作表進行保護。
3．編寫代碼
“鎖定隱藏公式”按鈕的VBA代碼如下：
Sub 鎖定和隱藏公式()
If ActiveSheet.ProtectContents = True Then
MsgBox "工作表已保護！"
Exit Sub
End If
Worksheets("Sheet1").Range("A1").CurrentRegion.Select
Selection.Locked = False
Selection.FormulaHidden = False
Selection.SpecialCells(xlCellTypeFormulas).Select
Selection.Locked = True
Selection.FormulaHidden = True
Worksheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Worksheets("Sheet1").EnableSelection = xlNoRestrictions
End Sub
例257 將單元格公式轉換為數值
1．案例說明
打開本例工作簿如圖12-5所示，在當前工作表中單元格區域“J3:J15”和“D16:I15”中都定義了公式，單擊選擇這兩個區域中的任意一個單元格，編輯欄中將顯示該單元格的公式。
單擊工作表左上角的“公式轉為數值”按鈕，當前工作表中所有公式單元格的公式定義都將被具體計算值所替代，這時再修改引用單元格的值，這兩個區域的值不會再變化了。
圖12-5 將公式轉為數值
2．關鍵技術
將單元格公式轉換為計算結果的表示方法很簡單，只需通過以下的賦值運算即可：
rng.Value = rng.Value
以上賦值語句中，rng表示Range對象，該語句首先通過右側的表達式rng.Value獲取指定單元格的值（如果是公式，則獲取公式的計算結果），再將該值賦值給單元格的Value變量，從而取代單元格原有的內容（公式）。
3．編寫代碼
“公式轉為數值”按鈕的VBA代碼如下：
Sub 公式轉為數值()
Dim rng As Range, c As Range
Set rng = ActiveSheet.Range("A1").CurrentRegion
For Each c In rng.Cells
If c.HasFormula Then
c.Value = c.Value
End If
Next
End Sub
以上代碼首先獲取工作表的當前區域，再逐個單元格判斷，如果單元格有公式，則進行轉換。
例258 刪除所有公式
1．案例說明
在Excel中，當單元格的數據發生改變后，引用該單元格的公式單元格的值也會隨之變化。有時希望經過計算后，具有公式的單元格的值不再隨著引用單元格而變化。這時可以刪除工作表中的公式，取消與引用單元格的關聯。
打開本例工作簿如圖12-6所示，在如圖所示的工作表中部分單元格具有公式，單擊選擇單元格I16，在編輯欄中可看到具體的公式。
圖12-6 具有公式的工作表
單擊“刪除所有公式”按鈕，將打開如圖12-7所示的對話框，詢問用戶是否刪除提示工作簿中的所有公式，單擊“是”按鈕工作簿中各工作表中的公式都將被刪除，如圖12-8所示選中單元格I16，編輯欄中可以看到顯示的是具體的值，公式已被刪除。
圖12-7 確認操作
圖12-8 刪除公式的工作表
2．關鍵技術
本例代碼與上例類似，不同的是本例將對所有打開工作簿進行處理，對每個工作簿的每張工作表進行循環，將具有公式的單元格轉換為具體的數值。
3．編寫代碼
“刪除所有公式”按鈕的VBA代碼如下：
Sub 刪除所有公式()
Dim wb1 As Workbook, ws1 As Worksheet
Dim rng As Range, rng1 As Range
For Each wb1 In Workbooks
With wb1
If MsgBox("是否刪除工作簿“" & wb1.Name & "”中的所有公式？", _
vbQuestion + vbYesNo) = vbYes Then
For Each ws1 In .Worksheets
On Error Resume Next
Set rng1 = ws1.UsedRange.SpecialCells(xlCellTypeFormulas)
'獲取公式單元格區域引用
For Each rng In rng1
rng.Value = rng.Value '將公式轉換成數值
Next
Next
End If
End With
Next
End Sub
例259 用VBA表示數組公式
1．案例說明
打開本例工作簿如圖12-9所示。在Excel中，可以通過定義數組公式計算銷售總金額。但是如果銷售日報表中銷售商品的數量不確定（占用表格的行是動態的），使用固定的數組公式就不太方便。
圖12-9 銷售日報表
本例使用VBA動態定義數組公式，在圖12-9所示工作表中輸入數據，然后單擊“匯總金額”按鈕，在單元格F5中將根據錄入數據的行數自動生成數組公式，如圖12-10所示，在編輯欄可看到數組公式為：
{=SUM(B4:B9*C4:C9)}
2．關鍵技術
使用Range對象的FormulaArray屬性，可獲取或設置區域的數組公式。如果指定區域不包含數組公式，則該屬性返回null。
圖12-10 生成數組公式
3．編寫代碼
“匯總金額”按鈕的VBA代碼如下：
Sub 匯總金額()
Dim r As Long
r = ActiveSheet.Range("A3").End(xlDown).Row
Range("F5").FormulaArray = "=SUM(B4:B" & r & "*C4:C" & r & ")"
End Sub
12.2 數據查詢
在Excel中，數據查詢是最常用的操作。在“開始”選項卡的“編輯”組中單擊“查找和選擇”按鈕，從下拉的菜單按鈕中選擇相應的命令即可進行查詢操作。在VBE中，可使用Find方法進行查詢相關的操作，本節實例演示查詢數據的VBA代碼。
例260 查找指定的值
1．案例說明
打開本例工作簿如圖12-11所示，單擊左上角的“查找”按鈕，彈出“查找”對話框如圖12-12所示，在該對話框中輸入要查找的值（如本例中輸入200），單擊“確定”按鈕，查找的結果顯示在如圖12-13所示的對話框中，同時工作表中對應單元格也加亮顯示，如圖12-14所示。
圖12-11 查找工作表 圖12-12 輸入查找值
圖12-13 查找結果 圖12-14 加亮顯示
2．關鍵技術
本例的查找使用了Range對象的兩個方法：Find方法和FindNext方法。
（1）Find方法
使用該方法可以在區域中查找特定信息。其語法格式如下：
表達式.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
該方法的參數很多，其中What參數是必須指定的，其余參數都可省略。各參數的含義如下：
— What：要搜索的數據。可為字符串或任意Excel數據類型。
— After：表示搜索過程將從其之后開始進行的單元格。此單元格對應于從用戶界面搜索時的活動單元格的位置。After必須是區域中的單個單元格。要記住搜索是從該單元格之后開始的；直到此方法繞回到此單元格時，才對其進行搜索。如果不指定該參數，搜索將從區域的左上角的單元格之后開始。
— LookIn：信息類型。
— LookAt：設置匹配文本的方式。可為常量xlWhole（匹配全部搜索文本）或xlPart（匹配任一部分搜索文本）。
— SearchOrder：指定搜索區域的次序。可為常量xlByRows（按行）或xlByColumns（按列）搜索。
— SearchDirection：搜索的方向。可為常量xlNext（在區域中搜索下一匹配值）或xlPrevious（在區域中搜索上一匹配值）。
— MatchCase ：如果為True，則搜索區分大小寫。默認值為False。
— MatchByte：只在已經選擇或安裝了雙字節語言支持時適用。如果為True，則雙字節字符只與雙字節字符匹配。如果為False，則雙字節字符可與其對等的單字節字符匹配。
— SearchFormat：搜索的格式。
使用該方法將返回一個Range對象，它代表第一個在其中找到該信息的單元格。如果未發現匹配項，則返回Nothing。Find方法不影響選定區域或當前活動的單元格。
—
每次使用此方法后，參數LookIn、LookAt、SearchOrder和MatchByte的設置都將被保存。如果下次調用此方法時不指定這些參數的值，就使用保存的值。設置這些參數將更改“查找”對話框中的設置，如果省略這些參數，更改“查找”對話框中的
— 設置將更改使用的保存值。要避免出現這一問題，每次使用此方法時最好明確設置這些參數。
（2）FindNext方法
FindNext方法繼續由Find方法開始的搜索。查找匹配相同條件的下一個單元格，并返回表示該單元格的Range對象。該操作不影響選定內容和活動單元格。其語法格式如下：
表達式.FindNext(After)
參數After指定一個單元格，查找將從該單元格之后開始。此單元格對應于從用戶界面搜索時的活動單元格位置。
—
After必須是查找區域中的單個單元格。搜索是從該單元格之后開始的；直到本方法環繞到此單元格時，才檢測其內容。如果未指定本參數，查找將從區域的左上角單元格之后開始。
當查找到指定查找區域的末尾時，FindNext方法將環繞至區域的開始繼續搜索。發生環繞后，為停止查找，可保存第一次找到的單元格地址，然后測試下一個查找到的單元格地址是否與其相同。
3．編寫代碼
“查找”按鈕的VBA代碼如下：
Sub 查找指定值()
Dim result As String, str1 As String, str2 As String
Dim c As Range
result = Application.InputBox(prompt:="請輸入要查找的值：", Title:="查找", Type:=2)
If result = "False" Or result = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveSheet.Cells
Set c = .Find(result, , , xlWhole, xlByColumns, xlNext, False)
If Not c Is Nothing Then
str1 = c.Address
Do
c.Interior.ColorIndex = 4 '加亮顯示
str2 = str2 & c.Address & vbCrLf
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> str1
End If
End With
MsgBox "查找到指定數據在以下單元格中：" & vbCrLf & vbCrLf _
& str2, vbInformation + vbOKOnly, "查找結果"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
以上代碼首先讓用戶輸入查找的值，接著使用Find方法查找第一個滿足條件的單元格，再使用循環查找當前工作簿中下一個滿足條件的單元格，并在循環中對滿足條件的單元格設置不同的底紋，以突出顯示。
例261 帶格式查找
1．案例說明
打開本例工作簿如圖12-15所示，單擊左上角的“查找指定格式”按鈕，單元格A2將被選中，并填上不同的底色。
圖12-15 帶格式查找
2．關鍵技術
本例使用Application對象的FindFormat屬性，設置要查找的單元格格式類型的搜索條件，然后使用Find方法按格式進行查找。
3．編寫代碼
“查找指定格式”按鈕的VBA代碼如下：
Sub 查找指定格式()
With Application.FindFormat.Font
.Name = "宋體"
.FontStyle = "Bold"
.Size = 11
End With
Cells.Find(what:="", SearchFormat:=True).Activate
Selection.Interior.ColorIndex = 4 '加亮顯示
End Sub
以上代碼首先使用FindFormat屬性設置查找的格式條件，接著使用Find方法按格式查找并激活滿足條件的單元格，最后加亮顯示激活單元格。
例262 查找上一個/下一個數據
1．案例說明
打開本例工作簿如圖12-16所示，單擊右上角的“查找”按鈕，將彈出輸入查找條件對話框，在對話框中輸入查找條件單擊“確定”按鈕，即可在當前工作表中查找滿足條件的單元格，找到滿足條件的單元格后，選中該單元格。
單擊“向前查找”或“向后查找”按鈕，可從當前單元格向前或向后查找滿足前面設置條件的單元格，并選中該單元格。
如果在使用“查找”按鈕輸入查找條件之前，就直接單擊“向前查找”或“向后查找”按鈕，也將彈出如圖12-17所示的“查找”對話框輸入查詢條件。
圖12-16 查找上一下/下一個數據 圖12-17 輸入查找條件
要重設查找條件，單擊“查找”按鈕打開如圖12-17所示對話框即可。
2．關鍵技術
（1）FindNext方法
使用該方法繼續由Find方法開始的搜索。查找匹配相同條件的下一個單元格，并返回表示該單元格的Range對象。該方法的語法格式如下：
表達式.FindNext(After)
參數After指定一個單元格，查找將從該單元格之后開始。此單元格對應于從用戶界面搜索時的活動單元格位置。After必須是查找區域中的單個單元格。搜索是從該單元格之后開始的；直到本方法環繞到此單元格時，才檢測其內容。如果未指定本參數，查找將從區域的左上角單元格之后開始。
當查找到指定查找區域的末尾時，本方法將環繞至區域的開始繼續搜索。發生環繞后，為停止查找，可保存第一次找到的單元格地址，然后測試下一個查找到的單元格地址是否與其相同。
（2）FindPrevious方法
該方法繼續由Find方法開始的搜索。查找匹配相同條件的上一個單元格，并返回代表該單元格的Range對象。其語法格式如下：
表達式.FindPrevious(After)
參數After指定一個單元格，查找將從該單元格之前開始。此單元格對應于從用戶界面搜索時的活動單元格的位置。
3．編寫代碼
（1）在VBE中插入一個模塊，使用以下代碼聲明一個模塊變量：
Dim c As Range
（2）“查找”按鈕的VBA代碼如下：
Sub 查找()
result = Application.InputBox(prompt:="請輸入要查找的值：", Title:="查找", Type:=2)
If result = "False" Or result = "" Then Exit Sub
Set c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlNext, False)
If Not c Is Nothing Then
c.Activate
End If
End Sub
以上代碼首先提示用戶輸入查詢條件，再使用Find方法向下查找。
（3）“向前查找”按鈕的VBA代碼如下：
Sub 向前查找()
Dim result As String, str1 As String, str2 As String
If c Is Nothing Then
result = Application.InputBox(prompt:="請輸入要查找的值：", Title:="查找", Type:=2)
If result = "False" Or result = "" Then Exit Sub
Set c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlPrevious, False)
Else
Set c = ActiveSheet.Cells.FindPrevious(c)
End If
If Not c Is Nothing Then
c.Activate
End If
End Sub
以上代碼首先判斷模塊變量c是否為空（判斷執行該子過程之前是否設置了查詢條件），若為空，則打開對話框讓用戶輸入查詢條件，并使用Find方法向前查找。若模塊變量c不為空，則調用FindPrevious方法向前查找。
（4）“向后查找”按鈕的VBA代碼如下：
Sub 向后查找()
Dim result As String, str1 As String, str2 As String
If c Is Nothing Then
result = Application.InputBox(prompt:="請輸入要查找的值：", Title:="查找", Type:=2)
If result = "False" Or result = "" Then Exit Sub
Set c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlNext, False)
Else
Set c = ActiveSheet.Cells.FindNext(c)
End If
If Not c Is Nothing Then
c.Activate
End If
End Sub
例263 代碼轉換
1．案例說明
打開本例工作簿如圖12-18所示，在單元格C3中輸入“101”，按回車鍵或Tab鍵后，單元格C3中輸入的值將轉換為“財務部”，如圖12-19所示。
圖12-18 輸入代碼
單擊工作表的“編碼”標簽，可看到編碼表中編碼與名稱的對應關系，如圖12-20所示。
圖12-19 轉換代碼 圖12-20 編碼表
2．關鍵技術
本例使用查表的方法，將工作表中指定列中輸入的代碼轉換為對應的值。在如圖12-20所示的“編碼”表中輸入編碼內容。
本例的關鍵技術是使用工作表事件Change事件來進行代碼的轉換。
當用戶更改工作表中的單元格，或外部鏈接引起單元格的更改時發生Change事件。該事件的參數Target為數據正在被更改的區域。
3．編寫代碼
在工作表“Sheet1”的Change事件中編寫以下VBA代碼：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, rng As Range, i As Long, c As Range
If Target.Column = 3 And Target.Row > 2 And Target.Value <> "" Then
t = Target.Value
With Worksheets("編碼")
i = .Range("A1").End(xlDown).Row
Set rng = .Range(.Cells(2, 1), .Cells(i, 1))
Set c = rng.Find(what:=t)
If c Is Nothing Then Exit Sub
Target.Value = c.Offset(0, 1).Value
End With
End If
End Sub
以上代碼首先對更改單元格的行和列進行判斷，如果是第3列第2行以下單元格，則執行編碼轉換的代碼。在轉換代碼時先獲取更改單元格的值，再從“編碼”工作表中查找相應的編碼，并將查到的編碼對應的名稱賦值給當前單元格，完成代碼的轉換。
例264 模糊查詢
1．案例說明
打開本例工作簿如圖12-21所示，單擊“模糊查詢”按鈕，彈出如圖12-22所示的對話框，在對話框中輸入查詢條件“劉”，單擊“確定”按鈕，即可在工作表中查找含有“劉”字的單元格，并為單元格填充底色，如圖12-23所示。
圖12-21 模糊查詢 圖12-22 查詢條件
圖12-23 加亮顯示查詢結果
2．關鍵技術
本例使用Like運算符進行模糊查詢。Like運算符可用來比較兩個字符串。其使用方法如下：
result = string Like pattern
Like運算符的語法具有以下幾個部分：
— result：運算的結果。
— string：被查詢的字符串。
— pattern：查詢字符串，該字符串可建立模式匹配。
如果string與pattern匹配，則result為 True；如果不匹配，則result為False。但是如果string或pattern中有一個為Null，則result為Null。
pattern中的字符可使用以下匹配模式：
— ?：可為任何單一字符。
— *：零個或多個字符。
— #：任何一個數字(0–9)。
— [charlist]：charlist中的任何單一字符。
— [!charlist]：不在charlist中的任何單一字符。
在中括號([ ])中，可以用由一個或多個字符(charlist)組成的組與string中的任一字符進行匹配，這個組幾乎包括任何一個字符代碼以及數字。
例如：
MyCheck = "張三" Like "張*" ' 返回 True
MyCheck = "F" Like "[A-Z]" ' 返回 True
MyCheck = "F" Like "[!A-Z]" ' 返回 False
MyCheck = "a2a" Like "a#a" ' 返回 True
3．編寫代碼
“模糊查詢”按鈕的VBA代碼如下：
Sub 模糊查詢()
Dim result As String, str1 As String
Dim c As Range, rng As Range
result = Application.InputBox(prompt:="請輸入要查找的值：", _
Title:="模糊查找", Type:=2)
If result = "False" Or result = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set rng = ActiveSheet.Range("A1").CurrentRegion
str1 = "*" & result & "*"
For Each c In rng.Cells
If c.Value Like str1 Then
c.Interior.ColorIndex = 4
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
以上代碼首先讓用戶輸入查詢條件，接著使用For循環逐個單元格進行比較，在比較時使用Like進行模糊查詢，如果單元格中包含有指定條件的值，則設置單元格的底色。
例265 網上查詢快件信息
1．案例說明
使用本例代碼可查詢申通快遞的快件投遞情況。打開本例工作簿如圖12-24所示，單擊“查詢快件”按鈕打開如圖12-25所示對話框，在對話框中輸入快件編號，單擊“確定”按鈕，經過一段時間后得到查詢結果如圖12-26所示。
圖12-24 查詢工作表 圖12-25 輸入快件編號
圖12-26 查詢結果
—
本例使用的快件編號進行了處理（虛擬編號），在使用本例代碼之前應確保計算已接入互聯網。
2．關鍵技術
（1）QueryTable對象
QueryTable對象代表一個利用從外部數據源（如SQL Server、Microsoft Access數據庫、網絡數據等）返回的數據生成的工作表表格。
QueryTable對象是QueryTables集合的成員。
（2）Add方法
使用QueryTables集合對象的Add方法可新建一個查詢表。其語法格式如下：
表達式.Add(Connection, Destination, Sql)
該方法參數的含義如下：
— Connection：查詢表的數據源。可為連接數據庫的連接字符串，也可以是一個Web查詢。Web查詢字符串的格式如下：
URL;<url>
其中“URL;”是必需的，字符串的其余部分作為Web查詢的URL。
— Destination：查詢表目標區域（生成的查詢表的放置區域）左上角的單元格。目標區域必須位于QueryTables對象所在的工作表中。
— Sql：在ODBC數據源上運行的SQL查詢字符串。當使用的數據源為ODBC數據源時，該參數可省略。
（3）Refresh方法
使用QueryTable對象的Refresh方法可更新外部數據區域(QueryTable)。該方法的語法格式如下：
表達式.Refresh(BackgroundQuery)
參數BackgroundQuery如果為True，則在數據庫建立連接并提交查詢之后，將控制返回給過程。QueryTable在后臺進行更新。如果為False，則在所有數據被取回到工作表之后，將控制返回給過程。如果沒有指定該參數，則由BackgroundQuery屬性的設置決定查詢模式。
在Excel建立一個成功的連接之后，將存儲完整的連接字符串，這樣，以后在同一編輯會話中調用Refresh方法時就不會再顯示提示。通過檢查Connection屬性的值可以獲得完整的連接字符串。
如果成功地完成或啟動查詢，則Refresh方法返回True；如果用戶取消連接或參數對話框，該方法返回False。
（4）使用Web查詢
在申能快遞的網站上可查詢快件的投遞情況，在瀏覽器中輸入以下網址：
http://www.sto.cn/querybill/webform1.aspx?wen=&Submit2=%B2%E9%D1%AF
將打開如圖12-27所示的查詢頁面，在文本區中輸入快件編號，單擊“查詢”按鈕即可在網頁上顯示指定編號的快件投遞情況。
圖12-27 通過網頁查詢快件投遞情況
如果要在Excel中通過VBA查詢快件投遞情況，只需要將前面的URL地址中的“wen=”字符串后面加上快件編號即可。
3．編寫代碼
“查詢快件”按鈕的VBA代碼如下：
Sub 查詢快件()
Dim str As String, strURL As String
str = Application.InputBox(prompt:="請輸入快件的編號：", _
Title:="申通快件查詢", Type:=2)
If str = "False" Then Exit Sub
strURL = "URL;http://www.sto.cn/querybill/webform1.aspx?wen="
strURL=strURL & str & "&Submit2=%E6%9F%A5%E8%AF%A2"
With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range("A2"))
.Name = "abc"
.FieldNames = True
.WebSelectionType = xlSpecifiedTables '導入指定表
.WebFormatting = xlWebFormattingNone '不導入任何格式
.WebTables = "1,2" '導入第一個和第二個表格中的數據
.BackgroundQuery = True '查詢異步執行（在后臺執行）
.Refresh BackgroundQuery:=False '更新數據
End With
End Sub
例266 查詢基金信息
1．案例說明
打開本例工作簿，單擊“查詢基金信息”按鈕，將在當前工作表中顯示當前基金的信息如圖12-28所示。
圖12-28 基金信息
2．關鍵技術
在網站http://tw.stock.yahoo.com/us/worldinx.html中可查詢基金的信息，如圖12-29所示。
在圖12-29所示的基金信息網頁中，上面用6個表格顯示了一些超鏈接信息。最下方的表格顯示具體各基金的數據，本例通過Web查詢只需要獲取下方的表格即可。通過查看HTML代碼，可知該表格是第7個表格，所以需要設置QueryTable對象的WebTables屬性為7。
3．編寫代碼
“查詢基金信息”按鈕的VBA代碼如下：
Sub 查詢基金信息()
Dim strURL As String
strURL = "URL;http://fund.sohu.com/r/cxo.php"
With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range("A2"))
.Name = "worldinx"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "7"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
圖12-29 網站查詢基金信息
例267 查詢手機所在地
1．案例說明
打開本例工作簿如圖12-30所示，單擊“手機所在地”按鈕打開如圖12-31所示對話框，輸入手機號碼后，單擊“確定”按鈕即可查詢出手機所在地，如圖12-32所示。
2．關鍵技術
本例與前面各例使用的Web查詢不同。本例使用http://www.123cha.com/網站來查詢手機所在地。其查詢的HTML代碼如下：
<form method="post" action="index.php">請輸入要查詢的手機號碼<b>前七位</b>或<b>全部</b>: <input type="text" name="query_mobile" size="18" class=tdc value= "">
<input type="submit" value="查 詢">
</form>
圖12-30 查詢手機所在地 圖12-31 輸入手機號碼
圖12-32 手機所在地
從以上HTML代碼可以看出，查詢手機所在地使用的是POST方法（另一種方式是GET方式，前面兩例使用的這種方式），這種方法將傳遞一個查詢變量到目標頁面，需要提供以下兩個參數：
— 第一個是查詢頁面，即QueryTable對象的Connection參數。該參數應該是<form>標簽中的action關鍵字后面的頁面。
— 另一個參數是POST方法的字符串，用于向Web服務器輸入數據以從Web查詢中返回數據。該參數通過PostText屬性進行設置，設置該屬性的值應該按以下格式：
.PostText = "query_mobile=13988888888"
其中query_mobile為HTML頁面中用戶輸入參數的域的名稱。
3．編寫代碼
“手機所在地”按鈕的VBA代碼如下：
Sub 查詢手機所在地()
Dim str As String, strURL As String
str = Application.InputBox(prompt:="請輸入手機號碼：", _
Title:="手機所在地查詢", Type:=2)
If str = "False" Then Exit Sub
If Left(str, 2) <> "13" Then
MsgBox "請輸入正確的手機號碼！", vbCritical + vbOKOnly, "提示"
Exit Sub
End If
strURL = "URL;http://www.123cha.com/sj/index.php"
With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range("A2"))
.Name = "cxo"
.PostText = "query_mobile=" & str
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
例268 使用字典查詢
1．案例說明
打開本例工作簿如圖12-33所示，在如圖所示工作表中列出了員工的姓名，“工資”列為空。單擊“查詢基礎工資”按鈕，“工資”列將自動填充員工對應的工資數據，如圖12-34所示。
圖12-33 空表 圖12-34 填充基礎工資 圖12-35 基礎工資表
“基礎工資表”工作表中的數據如圖12-35所示，本例根據該工作表中的數據自動填充對應員工的工資。
2．關鍵技術
（1）Dictionary對象
Dictionary對象用于在結對的名稱/值中存儲信息（等同于鍵/項目）。Dictionary對象看似比數組更為簡單，然而，Dictionary對象卻是更令人滿意的處理關聯數據的解決方案。使用Dictionary對象的屬性和方法可操作具體的數據項。本例使用以下方法控制字典對象：
— Add：向Dictionary對象添加新的鍵/項目對。
— Exists：返回一個邏輯值，這個值可指示某個指定的鍵是否存在于Dictionary對象中。
— Items：返回Dictionary對象中所有項目的一個數組。
（2）Transpose方法
使用該方法將返回轉置單元格區域，即將一行單元格區域轉置成一列單元格區域，反之亦然。在行列數分別與數組的行列數相同的區域中，必須將TRANSPOSE輸入為數組公式中。使用TRANSPOSE可在工作表中轉置數組的垂直和水平方向。該方法的語法格式如下：
表達式.Transpose(Arg1)
參數Arg1是要進行轉置的工作表中的單元格數組或區域。所謂數組的轉置就是，將數組的第一行作為新數組的第一列，將數組的第二行作為新數組的第二列，依此類推。
3．編寫代碼
“查詢基礎工資”按鈕的VBA代碼如下：
Sub 查詢基礎工資()
Dim arr, ds
Dim j As Long, k As Long, i As Long
Application.ScreenUpdating = False
Set ds = CreateObject("Scripting.Dictionary") '創建數據字典對象
With Worksheets("工資表")
j = .Range("B2").End(xlDown).Row
.Range("B3:B" & j) = "" 清除“工資”列中的數據
k = .Range("A3").End(xlDown).Row
arr = .Range("A3:A" & k) 將“姓名”列賦值到數組中
For i = 3 To k 將每個姓名作為一個字典對象的數據項
ds.Add arr(i - 2, 1), ""
Next
End With
With Worksheets("基礎工資表")
j = .Range("A3").End(xlDown).Row
arr = .Range("A3:B" & j)
End With
On Error Resume Next
For i = 3 To j '在“基礎工資表”查詢“姓名”，有相同的姓名，則將工資保存到字典對象中
If ds.Exists(arr(i - 2, 1)) Then ds(arr(i - 2, 1)) = _
ds(arr(i - 2, 1)) & arr(i - 2, 2)
Next
Worksheets("工資表").Range("B3").Resize(k - 2, 1) = _
WorksheetFunction.Transpose(ds.Items)
Set ds = Nothing
Application.ScreenUpdating = True
End Sub
12.3 數據排序
在Excel 2007中，在“開始”選項卡的“編輯”組中單擊“排序和篩選”按鈕，從下拉的菜單按鈕中選擇相應的命令即可進行排序操作。在VBE中，可使用Sort方法進行排序相關的操作，本節實例演示數據排序的VBA代碼。
例269 用VBA代碼排序
1．案例說明
打開本例工作簿如圖12-36所示，單擊左上角的“按姓名排序”按鈕，工作表中的數據按姓名升序排列，如圖12-37所示。
2．關鍵技術
在Excel 2007操作環境中進行排序時，在單元格中單擊作為關鍵字的列，選擇“開始”選項卡“編輯”組中的“排序和篩選”按鈕中的相關命令可對工作表中的數據進行排序。但這時參與排序的是所有數據行，在如圖12-36所示工作表中的數據排序時，最后一行（“合計”）也參與排序，使數據出現不希望的排序結果。
這時使用VBA代碼可方便地控制排序的區域，Range對象的Sort方法可對值區域進行排序。其語法格式如下：
表達式.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)
圖12-36 數據表
圖12-37 排序后的數據
該方法有很多參數，這些參數都可省略。各參數的含義如下：
— Key1：指定第一排序字段，作為區域名稱（字符串）或Range對象；確定要排序的值。
— Order1：確定Key1中指定的值的排序次序，可設置為常量xlAscending（升序）或xlDescending（降序）。
— Key2：第二排序字段。
— Type：指定要排序的元素。
— Order2：確定Key2中指定的值的排序次序。
— Key3：第三排序字段。
— Order3：確定Key3中指定的值的排序次序。
— Header：指定第一行是否包含標題信息。
— OrderCustom：指定在自定義排序次序列表中的基于1的整數偏移。
— MatchCase：設置為True，則執行區分大小寫的排序，設置為False，則執行不區分大小寫的排序；不能用于數據透視表。
— Orientation：指定以升序還是降序排序。可用常量xlSortColumns（按列排序）或xlSortRows（按行排序，這是默認值）。
— SortMethod：指定排序方法。可用常量xlPinYin（按漢語拼音順序排序，這是默認值）或xlStroke（按每個字符的筆畫數排序）。
— DataOption1：指定Key1中所指定區域中的文本的排序方式，可使用常量xlSortNormal（分別對數字和文本數據進行排序，這是默認值）或xlSortTextAsNumbers（將文本作為數字型數據進行排序）。
— DataOption2：指定Key2中所指定區域中的文本的排序方式。
— DataOption3：指定Key3中所指定區域中的文本的排序方式。
—
— 使用Sort方法排序時，最多只能按3個關鍵字進行排序。
—
3．編寫代碼
“按姓名排序”按鈕的VBA代碼如下：
Sub 排序()
Dim rng As Range, r As Long, c As Long
r = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
c = ActiveSheet.Range("A2").CurrentRegion.Columns.Count
Set rng = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))
rng.Sort key1:=ActiveSheet.Range(Cells(3, 2), Cells(r - 1, 2))
End Sub
以上代碼首先獲取當前工作表中需要排序的單元格區域，對該區域使用Sort方法按“姓名”列進行排序。
例270 亂序排序
1．案例說明
在很多情況下，希望得到一種無序的數據排列，使用亂序排序的方法可得到這種效果，本例演示這種效果。打開本例工作簿，單擊工作表左上角的“亂序排序”按鈕，工資表中的數據將呈無序排列，如圖12-38所示。
圖12-38 亂序排序
2．關鍵技術
使用亂序排序的一種算法是：在需要排序的數據右側生成一列隨機數據，然后以該隨機數的列作為關鍵字進行排序，即可得到亂序的效果。
3．編寫代碼
“亂序排序”按鈕的VBA代碼如下：
Sub 亂序排序()
Dim rng As Range, r As Long, c As Long
Randomize
Application.ScreenUpdating = False
With ActiveSheet
r = .Range("A1").CurrentRegion.Rows.Count
c = .Range("A2").CurrentRegion.Columns.Count
For i = 3 To r – 1 '添加隨機數據
.Cells(i, c + 1) = Int((Rnd * 100) + 1)
Next
Set rng = .Range(Cells(3, 1), Cells(r - 1, c + 1))
rng.Sort key1:=.Range(Cells(3, c + 1), Cells(r - 1, c + 1))
.Columns(c + 1).Clear '清除添加的隨機數據
End With
Application.ScreenUpdating = True
End Sub
以上代碼首先在需要排序的數據右列添加隨機數據，再使用Sort方法按該列的數據進行排序，最后刪除增加的隨機數據列。
例271 自定義序列排序
1．案例說明
打開本例工作簿，單擊“自定義序列排序”按鈕，工作表中的數據將按C列（部門）中的數據按自定義序列排序，如圖12-39所示。自定義序列如圖12-40所示，在圖12-40所示工作表中更改數據的排列順序后，再單擊“自定義序列排序”按鈕，C列（部門）又將按新的序列重新排列。
2．關鍵技術
本例演示用VBA代碼創建自定義序列的方法，主要用AddCustomList方法添加自定義序列，用DeleteCustomList方法刪除自定義序列。
（1）AddCustomList方法
用該方法為自定義自動填充和/或自定義排序添加自定義列表。其語法格式如下：
表達式.AddCustomList(ListArray, ByRow)
圖12-39 自定義序列排序 圖12-40 自定義序列
參數的含義如下：
— ListArray：將源數據指定為字符串數組或Range對象。
— ByRow：僅當ListArray為Range對象時使用。如果為True，則使用區域中的每一行創建自定義列表；如果為False，則使用區域中的每一列創建自定義列表。如果省略該參數，并且區域中的行數比列數多（或者行數與列數相等），則Excel使用區域中的每一列創建自定義列表。如果省略該參數，并且區域中的列數比行數多，則Excel使用區域中的每一行創建自定義列表。
—
— 如果要添加的列表已經存在，則本方法不起作用。
—
（2）GetCustomListNum方法
使用Application對象的GetCustomListNum方法返回字符串數組的自定義序列號。其語法格式如下：
表達式.GetCustomListNum(ListArray)
參數ListArray為一個字符串數組。
（3）DeleteCustomList方法
使用Application對象的DeleteCustomList方法刪除一個自定義序列。其語法格式如下：
表達式.DeleteCustomList(ListNum)
參數ListNum為自定義序列數字。此數字必須大于或等于5（Excel有4個不可刪除的內置自定義序列）。
3．編寫代碼
“自定義序列排序”按鈕的VBA代碼如下：
Sub 自定義序列排序()
Dim rng As Range, r As Long, c As Long, n As Integer
Dim rng1 As Range, arr1
Application.ScreenUpdating = False
'獲取排序的單元格區域
r = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
c = ActiveSheet.Range("A2").CurrentRegion.Columns.Count
Set rng1 = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))
'添加自定義序列
With Worksheets("Sheet2")
r = .Range("A1").End(xlDown).Row
Set rng = .Range(.Cells(1, 1), .Cells(r, 1))
End With
With Application
arr1 = .WorksheetFunction.Transpose(rng)
.AddCustomList ListArray:=arr1
n = .GetCustomListNum(arr1)
End With
'用自定義序列排序
rng1.Sort key1:=ActiveSheet.Range(Cells(3, 3), Cells(r - 1, 3)), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=n + 1
Application.DeleteCustomList ListNum:=n '刪除自定義序列
Application.ScreenUpdating = True
End Sub
以上代碼首先獲取需要排序的單元格區域，接著將工作表Sheet 2中的數據添加到自定義序列中，再使用自定義序列進行排序，最后刪除自定義序列。
例272 多關鍵字排序
1．案例說明
在Excel中對數據進行排序時，最多只能使用3個關鍵字排序，如果3個關鍵字相同時，要使用4個或更多關鍵字排序就比較麻煩。本例演示使用4個關鍵字排序的方法。
打開本例工作簿，單擊工作表左上角的“多關鍵字排序”按鈕，工作表中的數據將按C列到F列（共4列）的數據進行排序，得到如圖12-41所示的結果。從圖中可以看出，首先按C列（部門）排序，部門相同時再按D列（基礎工資）排序，基礎工資相同再按E列（崗位工資）排序，崗位工資相同再按F列（工齡工資）排序。如銷售部兩員工的基礎工資、崗位工資都相同，則按工齡工資排序（陳晴工齡工資低，排在前面）。
2．關鍵技術
對于超過三個關鍵字的排序，本例使用的方法時，先將數據按最后一個關鍵字排序，接著再將數據按倒數第二個關鍵字排序，……，最后將數據按主要（第一個）關鍵字排序，即可得到所需要的排列。
使用這種方法，可使用任意數量的關鍵字進行排序。
圖12-41 多關鍵字排序
3．編寫代碼
“多關鍵字排序”按鈕的VBA代碼如下：
Sub 多關鍵字排序()
Dim rng1 As Range, r As Long, c As Long, i As Integer
Application.ScreenUpdating = False
'獲取排序的單元格區域
r = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
c = ActiveSheet.Range("A2").CurrentRegion.Columns.Count
Set rng1 = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))
With rng1
For i = 6 To 3 Step -1
.Sort key1:=ActiveSheet.Range("C3").Offset(, i - 3)
Next
End With
Application.ScreenUpdating = True
End Sub
例273 輸入數據自動排序
1．案例說明
打開本例工作簿，在B列中輸入姓名，如圖12-42所示，當按回車鍵或Tab鍵完成該列單元格的輸入時，輸入的數據將自動按順序排列到工作表的相應行中，如圖12-43所示。
2．關鍵技術
本例需要根據用戶對單元格數據的更改及時完成排序，所以需要在工作表的Change事件過程中編寫代碼，有關該事件過程的應用在本書前面多個例子都在使用。
另外本例還使用了Application對象的Intersect方法，該方法返回一個Range對象，該對象表示兩個或多個區域重疊的矩形區域。其語法格式如下：
表達式.Intersect(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
該方法最多可使用30個單元格區域作為參數，至少需使用兩個參數。
圖12-42 輸入數據
圖12-43 自動排序
在本例中，使用以下表示方法判斷Target和單元格區域[B3:B1000]是否有重疊，若有重疊，則表示Target包含在區域[B3:B1000]中，否則，則是在該區域之外。
Application.Intersect(Target, [B3:B1000])
3．編寫代碼
要完成本例的功能，需要在工作表的Change事件過程中編寫以下代碼：
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub '修改的數據不是第2列，退出
If Not Application.Intersect(Target, [B3:B1000]) Is Nothing Then
Set rng = ActiveSheet.Range("A1").CurrentRegion
Set rng = rng.Offset(2, 0).Resize(rng.Rows.Count - 2, rng.Columns. Count)
rng.Sort Key1:=Range("B3")
End If
End Sub
以上代碼首先判斷更改數據的單元格是否為第2列，接著判斷更改數據單元格是否為“B3:B1000”單元格區域中的單元格，然后獲取當前區域需要排序的單元格區域，使用Sort方法對這個區域進行排序即可。
例274 數組排序
1．案例說明
打開本例工作簿如圖12-44所示，單擊“生成隨機數”按鈕，打開如圖12-45所示對話框，在對話框中輸入需要生成的隨機數數量，單擊“確定”按鈕即可生成相應的隨機數，如圖12-46所示。
圖12-44 空工作表 圖12-45 輸入數量
單擊“排序”按鈕，將生成的隨機數按升序排列，如圖12-47所示。
圖12-46 生成隨機數 圖12-47 排序
2．關鍵技術
Excel工作表可以方便地和數組進行轉換，即單元格區域可以賦值給一個數組，數組也可以通過Transpose方法填充到單元格區域中去。
（1）單元格區域賦值給數組
使用以下方法可將單元格區域賦值給一個數組：
arr = ActiveSheet.Range("A1:A10")
使用這種賦值將產生一個二維數組，即使單元格區域只選擇一行（或一列），得到的也是一個二維數組。
（2）數組填充單元格區域
對于二維數組，可直接使用以下方法將其賦值給單元格區域：
ActiveSheet.Range("A1:A" & n) = arr
如果是一維數組，則需要使用Transpose方法對數組進行置換為列或列進行填充。
3．編寫代碼
（1）“生成隨機數”按鈕的VBA代碼如下：
Sub 生成隨機數()
Dim arr(), i As Long, n As Long
Randomize Timer
n = Application.InputBox(prompt:="請輸入要生成的隨機數數量（2-65536）：", _
Title:="輸入數量", Default:=10, Type:=1)
If n <= 0 Or r > 65536 Then Exit Sub
ReDim arr(1 To n) '定義動態數組
For i = 1 To n '循環生成隨機數
arr(i) = Int(Rnd * 10000)
Next
With ActiveSheet
.Columns(1).Clear
.Range("A1:A" & n) = Application.Transpose(arr) '數組賦值給單元格區域
End With
End Sub
（2）“排序”按鈕的VBA代碼如下：
Sub排序()
Dim arr, t
Dim i As Long, j As Long, n As Long
n = ActiveSheet.Range("A1").End(xlDown).Row
If n <= 1 Then Exit Sub
arr = ActiveSheet.Range("A1:A" & n) '單元格區域保存到數組中
For i = 1 To n - 1 '雙循環排序
For j = i + 1 To n
If arr(j, 1) < arr(i, 1) Then
t = arr(i, 1) '交換數據
arr(i, 1) = arr(j, 1)
arr(j, 1) = t
End If
Next
Next
ActiveSheet.Range("A1:A" & n) = arr '數組賦值給單元格區域
End Sub
例275 使用Small和Large函數排序
1．案例說明
打開本例工作簿，在工作表中單擊“生成隨機數”按鈕將打開如圖12-48所示的對話框，在對話框中輸入產生隨機數的個數，單擊“確定”按鈕將在工作表中的A列生成指定數量的隨機數。
單擊“升序排序”按鈕，生成的隨機數將按從小到大的順序排列，如圖12-49所示。單擊“降序排序”按鈕，生成的隨機數將按從大到小的順序排列。
圖12-48 輸入隨機數量 圖12-49 升序排序
2．關鍵技術
（1）Small方法
在VBA中通過WorksheetFunction對象的Small方法可調用Excel工作表函數Small。該方法將返回數據集中第k個最小值。其語法格式如下：
表達式.Small(Arg1, Arg2)
參數的含義如下：
— Arg1：需要確定第k個最小值的數值數據數組或區域。
— Arg2：要返回的數據在數組或區域中的位置（從最小值開始）。
如果Arg1為空，則Small將返回錯誤值#NUM!。
如果Arg2≤0或Arg2超過了數據點個數，則Small將返回錯誤值#NUM!。
如果n為數組中數據點的個數，則Small(array,1)等于最小值，Small(array,n)等于最大值。
（2）Large方法
與Small方法類似，Large方法返回數據集中第k個最大值（Small方法返回第k個最小值）。例如，可以使用函數Large得到第一名、第二名或第三名的得分。
3．編寫代碼
（1）“生成隨機數”按鈕的VBA代碼如下：
Sub 生成隨機數()
Dim arr(), i As Long, n As Long
Randomize Timer
n = Application.InputBox(prompt:="請輸入要生成的隨機數數量（2-65536）：", _
Title:="輸入數量", Default:=10, Type:=1)
If n <= 0 Or r > 65536 Then Exit Sub
ReDim arr(1 To n) '定義動態數組
For i = 1 To n '循環生成隨機數
arr(i) = Int(Rnd * 10000)
Next
With ActiveSheet
.Columns(1).Clear
.Range("A1:A" & n) = WorksheetFunction.Transpose(arr) '數組賦值給單元格區域
End With
End Sub
（2）“升序排序”按鈕的VBA代碼如下：
Sub 升序排序()
Dim arr, arr1(), i As Long, n As Long
n = ActiveSheet.Range("A1").End(xlDown).Row
If n <= 1 Then Exit Sub
arr = ActiveSheet.Range("A1:A" & n) '單元格區域保存到數組中
ReDim arr1(1 To n)
For i = 1 To n '選出第i個最小的數
arr1(i) = WorksheetFunction.Small(arr, i)
Next
ActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr1)
'數組賦值給單元格區域
End Sub
（3）“降序排序”按鈕的VBA代碼如下：
Sub 降序排序()
Dim arr, arr1(), i As Long, n As Long
n = ActiveSheet.Range("A1").End(xlDown).Row
If n <= 1 Then Exit Sub
arr = ActiveSheet.Range("A1:A" & n) '單元格區域保存到數組中
ReDim arr1(1 To n)
For i = 1 To n '選出第i個最大的數
arr1(i) = WorksheetFunction.Large(arr, i)
Next
ActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr1)
'數組賦值給單元格區域
End Sub
例276 使用RANK函數排序
1．案例說明
打開本例工作簿，單擊“生成隨機數”按鈕在工作表中的A列生成指定數量的隨機數。單擊“排序”按鈕，生成的隨機數將按從小到大的順序排列，如圖12-50所示。
2．關鍵技術
使用WorksheetFunction對象的Rank方法，可返回一個數字在數字列表中的排位。數字的排位是其大小與列表中其他值的比值（如果列表已排過序，則數字的排位就是它當前的位置）。
Rank方法語法的語法格式如下：
表達式.Rank(Arg1, Arg2, Arg3)
圖12-50 排序
各參數的含義如下：
— Arg1：為要查找其排位的數字。
— Arg2：數字列表數組或對數字列表的引用，為一個Range對象。
— Arg3：指定數字的排位方式的數字。
如果Arg3為0（零）或被省略，Excel會按照Arg2為按降序排序的列表對數字排位。如果Arg3不為零，Excel會按照Arg2為按升序排序的列表對數字排位。
—
函數RANK對重復數的排位相同。但重復數的存在將影響后續數值的排位。例如，在一列按升序排列的整數中，如果整數10出現兩次，其排位為5，則11的排位為 7（沒有排位為6的數值）。
3．編寫代碼
（1）“生成隨機數”按鈕的VBA代碼如下：
Sub 生成隨機數()
Dim arr(), i As Long, n As Long
Randomize Timer
n = Application.InputBox(prompt:="請輸入要生成的隨機數數量（2-65536）：", _
Title:="輸入數量", Default:=10, Type:=1)
If n <= 0 Or r > 65536 Then Exit Sub
ReDim arr(1 To n) '定義動態數組
For i = 1 To n '循環生成隨機數
arr(i) = Int(Rnd * 10000)
Next
With ActiveSheet
.Columns(1).Clear
.Range("A1:A" & n) = WorksheetFunction.Transpose(arr) '數組賦值給單元格區域
End With
End Sub
（2）“排序”按鈕的VBA代碼如下：
Sub 排序()
Dim arr, rng As Range, t As Long, i As Long
n = ActiveSheet.Range("A1").End(xlDown).Row
If n <= 1 Then Exit Sub
ReDim arr(1 To n)
Set rng = ActiveSheet.Range("A1:A" & n) '獲取單元格區域引用
For i = 1 To n
t = WorksheetFunction.Rank(rng(i, 1), rng, 1)
arr(t) = rng(i, 1)
Next
ActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr)
'數組賦值給單元格區域
End Sub
例277 姓名按筆畫排序
1．案例說明
在各種會議中，對出席會議（或選舉產生）的人員需要列出名單，這些名單一般是按姓名筆畫排序。Excel提供了按筆畫排序的方法，但用這種方法排序時也將會出現一些問題，例如：姓名為雙字的，一般要在姓和名之間加上一個空格，若為女性或少數民族，還要在姓名后面用括號標明。
本例編寫VBA代碼，對姓名按筆畫排序，能自動處理姓名之間有空格、有括號的情況。打開本例工作簿如圖12-51所示，單擊“按姓名筆畫排序”按鈕，將得到如圖12-52所示的排序結果。
本例自動生成按筆畫排序的漢字庫表，如圖12-53所示。該工作表根據“姓名”工作表中的漢字自動生成。
圖12-51 無序姓名 圖12-52 筆畫排序 圖12-53 漢字庫
2．關鍵技術
使用筆畫對數據進行排序時，需設置排序方法Sort的SortMethod屬性，該屬性指定中文排序方法。可設置為以下值：
— xlPinYin：按字符的漢語拼音順序排序。這是默認值。
— xlStroke：按每個字符的筆畫數排序。
本例的代碼很長，其工作流程如下：
（1）首先使用字典對象Dictionary保存姓名中的漢字。
（2）將字典對象中的漢字填充到“漢字庫”工作表的單元格區域。
（3）使用Sort方法按筆畫排序“漢字庫”中的漢字。
（4）刪除字典對象中原有的數據，重新將排序后的“漢字庫”工作表中的數據寫入字典對象中，并為每個漢字添加順序號。
（5）讀取“姓名”工作表中每個姓名，從字典對象中查詢每個字的順序號，對每個名字生成一個序列碼字符串，將“姓名”和序列碼字符串保存到一個二維數組中。
（6）對二維數組進行排序，得到按筆畫排序的姓名。
（7）將排序后的數組填充到“姓名”工作表中，得到如圖12-52所示的結果。
3．編寫代碼
“按筆畫排序”按鈕的VBA代碼如下，該子過程的代碼較長，可參考關鍵技術中介紹的工作程序理解每一部分的作用。
Sub 按筆畫排序()
Dim ds As Scripting.Dictionary '字典對象
Dim r As Long, i As Long, j As Integer
Dim c As String, xm As String, c1 As String
Dim str1 As String, n As Long
Dim arr, arr1()
Application.ScreenUpdating = False
Set ds = CreateObject("Scripting.Dictionary") '創建數據字典對象
With Worksheets("姓名")
r = .Range("A1").End(xlDown).Row
On Error Resume Next
For i = 1 To r
str1 = .Cells(i, 1).Value '獲取單元格的姓名
For j = 1 To Len(str1) '將字符串拆分為單個漢字
s = Mid(str1, j, 1)
If s <> " " Then
ds.Add s, s '添加字典中
If Err <> 0 Then Err.Clear
End If
Next
Next
On Error GoTo 0
End With
r = ds.Count '字典中的條目數量
With Worksheets("漢字庫")
.Columns(1).Clear '清除A列
.Range("A1").Resize(r, 1) = _
WorksheetFunction.Transpose(ds.Items) '將字典中的數字填充到A列
r = .Range("A1").End(xlDown).Row
With .Sort '對A列按筆畫排序
.SetRange Range("A1:A" & r)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlStroke
.Apply
End With
arr = .Range("A1:A" & r)
End With
ds.RemoveAll '刪除字典中的所有數據
For i = 1 To r '把漢字添加到字典中
ds.Add arr(i, 1), i
Next
With Worksheets("姓名")
r = .Range("A1").End(xlDown).Row
ReDim arr1(1 To r, 1 To 2) '生定義數組
For i = 1 To r
c = .Cells(i, 1) '獲取單元格的值
arr1(i, 1) = c '保存到數組中
xm = Replace(Replace(Replace(c, " ", ""), " ", ""), "（", "(")
'刪除空格，全角括號換為半角括號
xm = Left(xm, InStr(xm & "(", "(") - 1) '去掉括號及括號中的字符
c1 = ""
For j = 1 To Len(xm) '從字典中查詢生成序列碼字符串
c1 = c1 & CStr(Format(ds(Mid(xm, j, 1)), "0000"))
Next
arr1(i, 2) = c1 '保存姓名的序列碼字符串
Next
For i = 1 To r – 1 '雙循環排序
For j = i + 1 To r
If arr1(i, 2) > arr1(j, 2) Then '按姓名的序列碼字符串比較
t1 = arr1(i, 1) '交換數據
t2 = arr1(i, 2)
arr1(i, 1) = arr1(j, 1)
arr1(i, 2) = arr1(j, 2)
arr1(j, 1) = t1
arr1(j, 2) = t2
End If
Next
Next
.Range("A1:A" & r) = arr1 '將排序后的數組填充到單元格區域
End With
Application.ScreenUpdating = True
End Sub
12.4 數據篩選
在Excel 2007中，在“開始”選項卡的“編輯”組中單擊“排序和篩選”按鈕，從下拉的菜單按鈕中選擇相應的命令即可進行數據篩選操作。在VBE中，可使用AutoFilter方法進行自動篩選操作，使用AdvancedFilter方法可進行高級篩選操作，本節實例演示數據篩選的VBA代碼。
例278 用VBA進行簡單篩選
1．案例說明
打開本例工作簿如圖12-54所示，單擊工作表左上角的“篩選”按鈕彈出如圖12-55所示的對話框，在對話框中輸入篩選條件“財務部”，單擊“確定”按鈕，工作表中將自動出現自動篩選下拉箭頭，并且只顯示“部門”為“財務部”的數據，如圖12-56所示。
在如圖12-55所示的“篩選”對話框中不輸入任何值，直接單擊“確定”按鈕即可顯示全部數據。
圖12-54 用VBA篩選數據
圖12-55 輸入篩選條件 圖12-56 篩選結果
2．關鍵技術
使用Range對象的AutoFilter方法，可對Range區域的數據中使用“自動篩選”篩選一個列表。該方法的語法如下：
表達式.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown)
各參數的含義如下：
— Field：相對于作為篩選基準字段（從列表左側開始，最左側的字段為第一個字段）的字段的整型偏移量。
— Criteria1：篩選條件，為一個字符串。使用“=”可查找空字段，或者使用“<>”查找非空字段。如果省略該參數，則搜索條件為All。如果將Operator設置為xlTop10Items，則Criteria1指定數據項個數（例如，“10”）。
— Operator：指定篩選類型，可用常量如表12-2所示。
表12-2 篩選類型
名 稱
值
描 述
xlAnd
1
條件1和條件2的邏輯與
xlBottom10Items
4
顯示最低值項（條件1中指定的項數）
xlBottom10Percent
6
顯示最低值項（條件1中指定的百分數）
xlFilterCellColor
8
單元格顏色
xlFilterDynamic
11
動態篩選
xlFilterFontColor
9
字體顏色
xlFilterIcon
10
篩選圖標
xlFilterValues
7
篩選值
xlOr
2
條件1和條件2的邏輯或
xlTop10Items
3
顯示最高值項（條件1中指定的項數）
xlTop10Percent
5
顯示最高值項（條件1中指定的百分數）
— Criteria2：第二個篩選條件（一個字符串）。與Criteria1和Operator一起組合成復合篩選條件。
— VisibleDropDown：如果為True，則顯示篩選字段的自動篩選下拉箭頭。如果為False，則隱藏篩選字段的自動篩選下拉箭頭。默認值為True。
—
— 如果忽略全部參數，此方法僅在指定區域切換自動篩選下拉箭頭的顯示。
—
3．編寫代碼
“篩選”按鈕的VBA代碼如下：
Sub 篩選()
Dim str1 As String
str1 = Application.InputBox(prompt:="請輸入要篩選的部門名稱（空字符將顯示全部數據）：", _
Title:="篩選", Type:=2)
If str1 = "False" Then Exit Sub
If str1 = "" Then
Worksheets("Sheet1").Range("A1").AutoFilter field:=3
Else
Worksheets("Sheet1").Range("A1").AutoFilter _
field:=3, _
Criteria1:=str1
End If
End Sub
以上代碼首先要求用戶輸入篩選條件，接著判斷用戶輸入的是否為空，若為空，則顯示全部數據，若輸入的篩選條件不為空，則篩選等于輸入條件的數據。
例279 用VBA進行高級篩選
1．案例說明
打開本例工作簿如圖12-57所示，在下方的“條件區域”部分輸入條件，再單擊左上角的“高級篩選”按鈕，即可按條件區域中輸入的條件對數據進行高級篩選，得到如圖12-58所示的結果。
如果在條件區域刪除數據（例如刪除圖12-57下方的“財務部”和“>=1400”），再單擊“高級篩選”按鈕，工作表將顯示全部數據（取消高級篩選功能）。
圖12-57 高級篩選
圖12-58 高級篩選結果
若在條件區域不同行輸入條件，則將采用邏輯或關系篩選數據（即只要滿足一列條件即可），如圖12-59所示，可顯示“人事部”或“基礎工資”大于1400的數據。
圖12-59 邏輯或篩選
2．關鍵技術
Excel的高級篩選可用VBA代碼來實現，使用Range對象的AdvancedFilter方法即可進行高級篩選。
高級篩選必須在工作表中定義一個條件區域，通過該條件從列表中篩選或復制數據。如果初始選定區域為單個單元格，則使用單元格的當前區域。AdvancedFilter方法的語法格式如下：
表達式.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
該方法各參數的含義如下：
— Action：指定是否就地復制或篩選列表，可使用常量xlFilterCopy（將篩選出的數據復制到新位置）或xlFilterInPlace（保留數據不動）。
— CriteriaRange：條件區域。如果省略該參數，則沒有條件限制。
— CopyToRange：如果Action為xlFilterCopy，則該參數為復制行的目標區域。否則，忽略該參數。
— Unique：如果為True，則只篩選唯一記錄。如果為False，則篩選符合條件的所有記錄。默認值為False。
3．編寫代碼
“高級篩選”按鈕的VBA代碼如下：
Sub 高級篩選()
Dim rng As Range, rng1 As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual '手動重算
Set rng = Worksheets("Sheet1").Range("A19").CurrentRegion
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
Set rng1 = Worksheets("Sheet1").Range("A1").CurrentRegion
Set rng1=rng1.Offset(1,0).Resize(rng1.Rows.Count-1, rng1.Columns.Count)
rng1.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rng
Application.Calculation = xlCalculationAutomatic '自動重算
Application.ScreenUpdating = True
End Sub
以上代碼首先獲取工作表中條件區域和篩選數據區域的引用，最后使用AdvancedFilter方法對數據區域進行篩選。
例280 篩選非重復值
1．案例說明
打開本例工作簿，單擊工作表中的“生成隨機數”按鈕，將在工作表的A列生成1000個隨機數，再單擊“篩選非重復值”按鈕，可將左側生成的1000個隨機數中的非重復數篩選并復制到B列中，如圖12-60所示。
2．關鍵技術
本例使用Range對象的AdvancedFilter方法篩選非重復值，有關該方法的介紹參見上例中的內容。
圖12-60 篩選非重復值
3．編寫代碼
（1）“生成隨機數”按鈕的VBA代碼如下：
Sub 生成隨機數()
Dim i As Integer
Application.ScreenUpdating = False
Randomize
With ActiveSheet
For i = 2 To 1001
.Cells(i, 1) = Int(Rnd * 1000 + 1)
Next
End With
Application.ScreenUpdating = True
End Sub
（2）“篩選非重復值”按鈕的VBA代碼如下：
Sub 篩選非重復值()
Dim i As Long, rng As Range
Application.ScreenUpdating = False
With ActiveSheet
i = .Range("A1").End(xlDown).Row
If i > 1001 Then Exit Sub
Set rng = .Range(Cells(2, 1), Cells(i, 1))
.Columns("B").ClearContents
rng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("B2"), Unique:=True
End With
Application.ScreenUpdating = True
End Sub
例281 取消篩選
1．案例說明
打開本例工作簿如圖12-61所示，在如圖所示工作表中設置了自動篩選，單擊“取消篩選”按鈕，當前工作簿中每個工作表中的自動篩選都將取消，如圖12-62所示。
2．關鍵技術
如果當前在工作表上顯示有“自動篩選”下拉箭頭，則AutoFilterMode屬性值為True。設置該屬性值為False可取消自動篩選狀態。
圖12-61 篩選狀態的工作表
圖12-62 取消篩選的工作表
—
— 不能將該屬性設置為True。使用AutoFilter方法可篩選列表并顯示下拉箭頭。
—
3．編寫代碼
“取消篩選”按鈕的VBA代碼如下：
Sub 取消篩選()
Dim ws1 As Worksheet
For Each ws1 In Worksheets
ws1.AutoFilterMode = False
Next
End Sub
