VBA各种查询方法介绍和应用举例
目錄
- 前言
- 1 Range對象的Find方法
- 2. Range 對象的 Filter 方法
- 2.1 AutoFilte自動篩選
- 2.2 AdvancedFilter 高級篩選
- 3.Instr 函數
- 4.Like 運算符
- 5.SQL 查詢語句
- 6. ADO Recordset 對象 Find 方法和 Filter 屬性
- 6.1 Find 方法
- 6.2 Filter 屬性
- 7. 正則表達式
- 8.字典和哈希表
- 8.1 字典
- 8.2 哈希表
- 9.相似度計算
- 10. 其他方法
- 11. 查詢過程的效率問題
- 11.1 多余的顯示
- 11.1.1 使用 **ADO** 查詢的分頁技術。
- 11.1.2 使用數組的分頁技術
- 11.2多余的查詢
- 12. 補充
- 13．總結
- 14. 精彩點評
前言
查詢（或匹配）是程序設計中最重要的功能之一，只有用好查詢功能，才能從紛繁復雜的數據中找到符合要求的數據子集，提高工作效率。查詢分為模糊查詢和精確查詢，只匹配一個字符串中的部分字符串就是模糊查詢，完全一致則是精確批量，例如字符串“excelhome”，用包含“excel”的條件進行查詢是模糊查詢，用等于“excelhome” 的條件進行查詢則是精確查詢。查詢的方法多種多樣，本貼總結了10種VBA查詢方法，分享給大家，以博大方之家一笑，或者給初學者提供一點入門知識，不敢說什么拋磚引玉，因為我不是拋轉的專家，不求引玉，只要不引來石頭就夠了。
1 Range對象的Find方法
Find方法跟在工作表中按Ctrl+F查詢的效果一致，如果找到匹配單元格，該方法返回一個Range對象，沒找到則返回Nothing。語法為：
表達式.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)表達式是一個代表 Range 對象的變量。參數說明如下：
| What | 必選 | Variant | 要搜索的數據。可為字符串或任意 Microsoft Excel 數據類型。 |
| After | 可選 | Variant | 表示搜索過程將從其之后開始進行的單元格。此單元格對應于從用戶界面搜索時的活動單元格的位置。請注意：After 必須是區域中的 單個單元格。要記住搜索是從該單元格之后開始的；直到此方法繞回到此單元格時，才對其進行搜索。如果不指定該參數，搜索將從區域的左上角的單元格之后開始。 |
| LookIn | 可選 | Variant | 指定查找的范圍類型，可以為以下常量之一：xlValues、xlFormulas或者xlComments，默認值為xlFormulas。 |
| LookAt | 可選 | Variant | 可為以下 XlLookAt 常量之一：xlWhole 或 xlPart。 |
| SearchOrder | 可選 | Variant | 可為以下 XlSearchOrder 常量之一：xlByRows 或 xlByColumns。 |
| SearchDirection | 可選 | XlSearchDirection | 搜索的方向。 |
| MatchCase | 可選 | Variant | 如果為 True，則搜索區分大小寫。默認值為 False。 |
| MatchByte | 可選 | Variant | 只在已經選擇或安裝了雙字節語言支持時適用。如果為 True，則雙字節字符只與雙字節字符匹配。如果為 False，則雙字節字符可與其對等的單字節字符匹配。 |
| SearchFormat | 可選 | Variant | 搜索的格式。 |
常用的參數為What和LookAt，我們舉例說明。我們要在a2:a1550單元格中查找包含“132”的單元格（模糊查詢），并把字符顏色改為紅色，代碼如下：
Sub 查詢1()Dim c As Range, firstAddress$With Worksheets("數據庫").Range("a2:a1550")Set c = .Find("132", lookat:=xlPart) '查找132,xlPart模糊查詢,xlWhole精確查詢If Not c Is Nothing ThenfirstAddress = c.Address’記錄第一符合條件的地址Doc.Font.Color = vbRedSet c = .FindNext(c)Loop While Not c Is Nothing And c.Address <> firstAddress'退出條件End IfEnd With End Sub要注意的是，我們沒有指定After參數，程序從區域的左上角的單元格之后開始查詢，即A3開始查詢，并在程序最后返回到A2，才對A2單元格進行查找。這里FindNext是繼續由 Find方法開始的搜索。查找匹配相同條件的下一個單元格，并返回表示該單元格的 Range 對象。
Find 方法是直接在 Range 對象上操作，因此效率不高，在查詢量很少的時候可以用。如果查詢數量巨大，最好把數據放在數組中進行處理。
2. Range 對象的 Filter 方法
2.1 AutoFilte自動篩選
AutoFilter就是篩選，可使用多個條件進行查詢，可精確查詢和模糊查詢，并可使用通配符和比較運算符。通配符?表示 任何單一字符，* 表示零個或多個字符。語法：
表達式.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown)表達式是一個Range對象。
參數說明如下：
| Field | 可選 | Variant | 相對于作為篩選基準字段（從列表左側開始，最左側的字段為第一個字段）的字段的整型偏移量。 |
| Criterial | 可選 | Variant | 篩選條件（一個字符串；例如，“101”）。使用“=”可查找空字段，或者使用“<>”查找非空字段。如果省略該參數，則搜索條件為 All。如果將 Operator 設置為 xlTop10Items，則 Criteria1 指定數據項個數（例如，“10”）。 |
| Operator | 可選 | Variant | 指定篩選類型的 XlAutoFilterOperator 常量之一。 |
| Criteria2 | 可選 | Variant | 第二個篩選條件（一個字符串）。與 Criteria1 和 Operator 一起組合成復合篩選條件。 |
| VisibleDropDown | 可選 | Variant | 如果為 True，則顯示篩選字段的自動篩選下拉箭頭。如果為 False，則隱藏篩選字段的自動篩選下拉箭頭。默認值為 True。 |
XlAutoFilterOperator 可選值如下：
| 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 中指定的百分數）。 |
需要注意的是，如果忽略全部參數，此方法僅在指定區域切換自動篩選下拉箭頭的顯示，不執行篩選動作。Criteria1和Criteria2是每一列字段可用的兩個篩選關鍵詞，最多2個，可用XlAutoFilterOperator的值指定該2個關鍵詞之間的關系。如果需要多個字段進行篩選，請按順序依次使用該語句。
例如篩選“推薦業務1”字段中包含“和目1”、“推薦業務2”等于“"流量套餐2” 、“推薦業務3”等于“"放心用5”的數據并復制到其他工作表中：
Sub 查詢2()Application.ScreenUpdating = FalseWith Worksheets("數據庫").Range("a1:d1550").AutoFilter Field:=2, Criteria1:="*和目1*" '可使用通配符和比較運算符模糊查詢.AutoFilter Field:=3, Criteria1:="流量套餐2"’精確查詢.AutoFilter Field:=4, Criteria1:="放心用5"'……可以繼續增加更多條件Worksheets("結果集").UsedRange.ClearContents.Copy Worksheets("結果集").Range("a1").AutoFilter '取消自動篩選End WithApplication.ScreenUpdating = True End Sub代碼均以下圖數據集進行編寫:
2.2 AdvancedFilter 高級篩選
AdvancedFilter方法基于條件區域從列表中篩選或復制數據。如果初始選定區域為單個單元格，則使用單元格的當前區域。語法：
表達式.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)表達式為一個代表 Range 對象的變量。參數說明如下：
| Action | 必選 | XlFilterAction | XlFilterAction 的常量之一，用于指定是否就地復制或篩選列表。xlFilterCopy表示將篩選出的數據復制到新位置，xlFilterInPlace表示保留數據不動。 |
| CriteriaRange | 可選 | Variant | 條件區域。如果省略該參數，則沒有條件限制。 |
| CopyToRange | 可選 | Variant | 如果 Action 為 xlFilterCopy，則為復制行的目標區域。否則，忽略該參數。 |
| Unique | 可選 | Variant | 如果為 True，則只篩選唯一記錄。如果為 False，則篩選符合條件的所有記錄。默認值為 False。 |
為實現2.1節相同的查詢結果，CriteriaRange設置為：
代碼如下：
Sub 查詢3()Application.ScreenUpdating = FalseWorksheets("結果集").UsedRange.ClearContentsWith Worksheets("數據庫").Range("a1:d1550").AdvancedFilter xlFilterCopy, .Range("h1:k2"), Worksheets("結果集").Range("a1"), FalseEnd WithApplication.ScreenUpdating = True End Sub唯一需要說明的是CriteriaRange參數。條件區域至少包含兩行，第一行包含一個或多個列標題，是想要在數據區域中篩選的字段，第二行開始包含的是想要獲取的數據，可使用通配符，如果要獲取不同的數據，可分列多行（不同行的條件是“或”的關系，同行的條件是“與”的關系），例如“推薦業務3”想查詢“放心用5”或“放心用6”，在下圖的K3單元格中加上“放心用6”，CriteriaRange改為Range("h1:k3")即可。
3.Instr 函數
以上兩個方法都是針對Range對象的，實際運用中，很多數據都不在工作表中，沒有辦法使用上述的方法。其實，就算數據在工作表中，因為上述方法是對對象進行操作，也會嚴重影響效率，而首先會把數據裝進數組之中再行處理。這節介紹的Instr函數可以方便快捷的匹配數組中的數據。該函數返回指定一字符串在另一字符串中最先出現的位置。
語法：
InStr([start, ]string1, string2[, compare])，參數說明：
| start | 可選參數。為數值表達式，設置每次搜索的起點。如果省略，將從第一個字符的位置開始。如果 start 包含 Null，將發生錯誤。如果指定了 compare 參數，則一定要有 start 參數。 |
| string1 | 必要參數。接受搜索的字符串表達式。 |
| string2 | 必要參數。被搜索的字符串表達式。 |
| Compare | 可選參數。指定字符串比較。如果 compare 是 Null，將發生錯誤。如果省略 compare，Option Compare 的設置將決定比較的類型。指定一個有效的LCID (LocaleID) 以在比較中使用與區域有關的規則。 |
compare 參數可選值為：
| vbUseCompareOption | -1 | 使用 Option Compare 語句設置執行一個比較。 |
| vbBinaryCompare | 0 | 執行一個二進制比較。 |
| vbTextCompare | 1 | 執行一個按照原文的比較。 |
| vbDatabaseCompare | 2 | 僅適用于 Microsoft Access，執行一個基于數據庫中信息的比較。 |
注意：第一個參數和第四個參數可以省略，但如果指定了第四個參數，第一個參數也應指定。
為實現2.1節相同的查詢結果，可用代碼：
Sub 查詢4()Dim arr, brr, i&, j&, k&Application.ScreenUpdating = Falsearr = Worksheets("數據庫").Range("a1").CurrentRegionReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2)) '存放符合查詢條件的結果，數組大小跟arr一致'也可用Redim Preserve根據需要擴大數組，但只能擴大最后一維，故需要轉置數組，效率較低For i = 1 To UBound(arr, 2): brr(1, i) = arr(1, i): Next '存儲原標題j = 2For i = 2 To UBound(arr) '查詢條件，用Instr函數匹配字符串If InStr(arr(i, 2), "和目1") > 0 And arr(i, 3) = "流量套餐2" And arr(i, 4) = "放心用5" ThenFor k = 1 To UBound(arr, 2): brr(j, k) = arr(i, k): Nextj = j + 1End IfNextWith Worksheets("結果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithApplication.ScreenUpdating = True End Sub我們可以用InStr(arr(i, 2), “和目1”)的方式查詢數組元素arr(i, 2)中是否包含"和目1"（模糊查詢），也可以用一個Instr函數同時精確查詢多個關鍵詞，例如要“推薦業務3”字段中有"放心用5"、“放心用8"或"放心用9”，用InStr(“放心用5/放心用8/放心用9”, arr(i, 4))即可，比用邏輯運算符（And，Or等）連接多個條件更方便：arr(i, 4)=“放心用5” Or arr(i, 4)=“放心用8” Or arr(i, 4)=“放心用9” 。
Instr應用遠不僅此，例如想搞個自定義排名，除了可用Application.AddCustomList外，還可以用如Instr(“張三/李四/王五”,姓名)的形式，求得姓名所在位置，然后按這些位置排序即可，可根據實際需求應用。另外，InStrRev 函數跟Instr函數類似，也返回一個字符串在另一個字符串中出現的位置，但從字符串的 末尾 開始查詢。
4.Like 運算符
Like運算符用來比較兩個字符串，如果跟條件匹配，返回TRUE，否則返回FALSE。語法：
result = string Like patternLike運算符跟其他比較運算符的區別是模式匹配，其pattern參數可以用如下字符：
| ? | 任何單一字符。 |
| * | 零個或多個字符。 |
| # | 任何一個數字 (0–9)。 |
| [charlist] | charlist.中的任何單一字符。 |
| [!charlist] | 不在 charlist 中的任何單一字符。 |
為實現2.1節相同的查詢結果，可用代碼：
Sub 查詢5()Dim arr, brr, i&, j&, k&Application.ScreenUpdating = Falsearr = Worksheets("數據庫").Range("a1").CurrentRegionReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))For i = 1 To UBound(arr, 2): brr(1, i) = arr(1, i): Next '存儲原標題j = 2For i = 2 To UBound(arr) '查詢條件，用Like運算符匹配字符串，可用通配符If arr(i, 2) Like "*和目1*" And arr(i, 3) = "流量套餐2" And arr(i, 4) = "放心用5" ThenFor k = 1 To UBound(arr, 2): brr(j, k) = arr(i, k): Nextj = j + 1End IfNextWith Worksheets("結果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithApplication.ScreenUpdating = True End Sub由上可見，使用Like運算符的代碼跟使用Instr函數的代碼幾乎一致，但Like更靈活。
假如我們做一個窗體查詢界面，使用Instr函數也能實現查詢，但用Like運算符的好處是在查詢框中使用*和?運算符，也能使用字符集。例如我們想查詢表格中第一列的手機號中包括5、7或9的號碼，只需用arr(i, 1) Like "*[579]*"就行了，比Instr更簡潔。
查詢大量數據時，為了極大的提高效率，通常會先把數據放進數組中再進行匹配，故Instr和Like是最常用的查詢方式，我們要多運用，熟練于心。
5.SQL 查詢語句
SQL(結構化查詢語言Structured Query Language)是一門ANSI的標準計算機語言，用來訪問和操作數據庫系統。SQL 語句用于取回和更新數據庫中的數據。SQL 可與數據庫程序協同工作，比如 MS Access、DB2、Informix、MS SQL Server、Oracle、Sybase 以及其他數據庫系統。入門級的SQL語法可花2個小時就學會，可看 http://www.w3school.com.cn/sql/sql_select.asp 。
SQL語句配合ADO對象，能像操作數據庫一樣操作工作表，使得很多時候查詢代碼變得簡單易懂，也易于修改。且SQL語句查詢不用考慮工作表中列的變動（使用數組的話，如果某些列變動了位置，則需要修改代碼），只需維護SQL語句即可。SQL語句操作數據庫，也能實現復雜的匯總功能，如：http://club.excelhome.net/thread-1416073-1-1.html，因此花幾個小時去學習還是很劃算的。如果查詢到是數據要進行超過SQL語法能力的操作，可以用GetRows方法先轉成數組。
為實現2.1節相同的查詢結果，可用代碼：
Sub 查詢6()Dim objcnn As Object, objrst As Object, i&, sql$Application.ScreenUpdating = FalseSet objcnn = CreateObject("adodb.connection")Set objrst = CreateObject("adodb.recordset")objcnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=Yes';Data Source=" & ThisWorkbook.FullNamesql = "select * from [數據庫$A1:D] where 推薦業務1 like '%和目1%' and 推薦業務2='流量套餐2' and 推薦業務3='放心用5'"objrst.Open sql, objcnn, 1, 3With Worksheets("結果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標題.Cells(1, i + 1) = objrst.Fields(i).NameNext.Range("a2").CopyFromRecordset objrst '輸出數據End Withobjrst.Closeobjcnn.CloseSet objrst = NothingSet obcnn = NothingApplication.ScreenUpdating = True End Sub注意：在SQL語句中需用%代替*通配符*。
6. ADO Recordset 對象 Find 方法和 Filter 屬性
如果只是查詢并輸出數據，使用上一節的SQL語句足夠了，但是很多時候查詢是為了修改特定的數據，且需要多
處修改，如果使用 SQL UPDATE修改，會有諸多不便。首先各個數據庫的SQL語法稍有差異；其次UPDATE語
句也更復雜；還有，使用SQL語句頻繁訪問數據庫也是難以實現的，畢竟一臺計算機只能同時服務幾十個連接，
而使用 ADO Recordset 對象則可以把數據放在本地編輯，批量修改好之后再連接數據庫更新修改。
6.1 Find 方法
語法：Rst.Find (Criteria, SkipRows, SearchDirection, Start)，Rst 為 Recordset 數據集對象。
參數說明：
| Criteria | 必選 | String 值，包含指定用于搜索的列名、比較操作符和值的語句。 |
| SkipRows | 可選 | Long 值，其默認值為零，它指定當前行或 Start 書簽的行偏移量以開始搜索。在默認情況下，搜索將從當前行開始。 |
| SearchDirection | 可選 | SearchDirectionEnum 值，指定搜索應從當前行開始，還是從搜索方向的下一個有效行開始。如果該值為 adSearchForward，不成功的搜索將在 Recordset 的結尾處停止。如果該值為 adSearchBackward，不成功的搜索將在 Recordset 的開始處停止。 |
| Start | 可選 | Variant 書簽，用于標記搜索的開始位置。 |
一般只用第一個參數和第二個參數。在 criteria 中只能指定單列名稱，故不支持多列搜索，想要多列查詢，可用6.2節中的 Filter 屬性。
Criteria 中的比較操作符可以是>（大于）、<（小于）、=（等于）、>=（大于或等于）、<=（小于或等于）、<>（不等于）或like（模式匹配）。
Criteria 中的值可以是字符串、浮點數或者日期。字符串值用單引號或“#”標記（數字號）分隔（如“字段1= ‘值1’”或“字段1 =#值1#”）。日期值用#標記（數字號）分隔（如start_date > #7/22/97#）并可包括小時、分鐘和秒以指示時間戳，但不能包括毫秒，否則將出現錯誤。
如果比較操作符為like，可以在字符串值中包含星號 (*) 以查找一次或多次出現的任意字符或子字符串。
*（星號）可以只在條件字符串的結尾使用，也可以在條件字符串的開頭和結尾一起使用，如上所示（注：不能將星號作為前導通配符 ('*str') 或嵌入通配符 ('s*r') 使用。這將引發錯誤）。
查詢“推薦業務1”字段中包含“和目1”的代碼為：
Sub 查詢7()Dim objcnn As Object, objrst As Object, i&, sql$Application.ScreenUpdating = FalseSet objcnn = CreateObject("adodb.connection")Set objrst = CreateObject("adodb.recordset")objcnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=Yes';DataSource=" & ThisWorkbook.FullNamesql = "select * from [數據庫$A1:D]"objrst.Open sql, objcnn, 1, 3With Worksheets("結果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標題.Cells(1, i + 1) = objrst.Fields(i).NameNextj = 2objrst.MoveFirst '注意：數據集在查詢后可能不在第一行，每次查詢前移到第一行是穩妥行為'不指定開始行參數的情況下，Find會從當前行開始查詢objrst.Find "推薦業務1 like '*和目1*'"Do While Not objrst.EOFFor i = 0 To objrst.Fields.Count - 1 '輸出數據.Cells(j, i + 1) = objrst.Fields(i)Nextj = j + 1objrst.Find "推薦業務1 like '*和目1*'", 1LoopEnd Withobjrst.Closeobjcnn.CloseSet objrst = NothingSet obcnn = NothingApplication.ScreenUpdating = True End Sub6.2 Filter 屬性
用 Filter屬性選擇性地屏蔽 Recordset 對象中的記錄。條件字符串由字段名-操作符-值格式（如“字段1 = '值1'”）子句組成。通過連接單獨的 AND（如“字段1 = '值1' AND字段2= '值2'”）或 OR（如“字段1 = '值1' OR 字段2= '值2'”）子句可以創建復合子句。對于條件字符串，請遵循以下規則：
-
字段名必須是 Recordset 對象中有效的字段名（如果字段名包含空格，必須將字段名括在方括號中）；
-
操作符必須是下列字符串之一：<、>、<=、>=、<>、= 或 LIKE；
-
字符串使用單引號；
-
日期使用磅符號 (#)；
-
數字可以使用小數點、美元符號和科學符號；
-
如果操作符為LIKE，則值可以使用通配符，只允許使用星號 (*) 和百分號 (%) 通配符，可在模式的開頭和結尾使用通配符，（如 字段 Like '*ab*'），或者只在模式的結尾使用通配符（如 字段 Like 'Tab*'）。
-
AND 和 OR 在級別上沒有先后之分，可用括號將子句分組。但不能象下例所示那樣先將由 OR 連接的子句分組，然后再用 AND 將該組連接到其他子句：
(字段1=‘值1’ OR字段1=‘值2’) AND字段2=‘值3’，與之相反，可將此過濾構造為：
(字段1=‘值1’ AND字段2='值3') OR (字段1='值2' AND字段2='值3')
說明：值 是用于與字段值進行比較的值（如 '張三'、#8/24/95#、12.345）。
為實現2.1節相同的查詢結果，可用代碼：
Sub 查詢8()Dim objcnn As Object, objrst As Object, i&, sql$Application.ScreenUpdating = FalseSet objcnn = CreateObject("adodb.connection")Set objrst = CreateObject("adodb.recordset")objcnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=Yes';Data Source=" & ThisWorkbook.FullNamesql = "select * from [數據庫$A1:D]"objrst.Open sql, objcnn, 1, 3With Worksheets("結果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標題.Cells(1, i + 1) = objrst.Fields(i).NameNextobjrst.Filter = "推薦業務1 like '%和目1%' and 推薦業務2='流量套餐2' and 推薦業務3='放心用5'" '查詢篩選If objrst.RecordCount Then '篩選后如果有符合條件的子集，則RecordCount>0.Range("a2").CopyFromRecordset objrst '輸出數據End Ifobjrst.Filter = "" '這條語句清空篩選條件End Withobjrst.Closeobjcnn.CloseSet objrst = NothingSet obcnn = NothingApplication.ScreenUpdating = True End Sub如果 Recordset 對象的Find方法無法滿足需求，而你又不想使用Filter，那么，你可以像使用數組一樣循環 Recordset 對象，使用前面介紹的Instr和Like方法查詢。循環 Recordset 對象 的代碼如下：
Sub 查詢9()Dim objcnn As Object, objrst As Object, i&, j&, sql$Application.ScreenUpdating = FalseSet objcnn = CreateObject("adodb.connection")Set objrst = CreateObject("adodb.recordset")objcnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=Yes';Data Source=" & ThisWorkbook.FullNamesql = "select * from [數據庫$A1:D]"objrst.Open sql, objcnn, 1, 3With Worksheets("結果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標題.Cells(1, i + 1) = objrst.Fields(i).NameNextj = 2Do While Not objrst.EOFIf objrst("推薦業務1") Like "*和目1*" And objrst("推薦業務2") = "流量套餐2" And objrst("推薦業務3") = "放心用5" ThenFor i = 0 To objrst.Fields.Count - 1 '輸出數據.Cells(j, i + 1) = objrst.Fields(i)Nextj = j + 1End Ifobjrst.MoveNextLoop '================================================================== '或者如下代碼。注意：objrst(i)=objrst.Fields(i)，且字段下標是從0開始的。 ' ' Do While Not objrst.EOF ' If objrst(1) Like "*和目1*" And objrst(2) = "流量套餐2" And objrst(3) = "放心用5" Then ' For i = 0 To objrst.Fields.Count - 1 '輸出數據 ' .Cells(j, i + 1) = objrst(i) ' Next ' j = j + 1 ' End If ' objrst.MoveNext ' Loop ' '==================================================================End Withobjrst.Closeobjcnn.CloseSet objrst = NothingSet obcnn = NothingApplication.ScreenUpdating = True End Sub如果你更想把 Recordset 對象 轉成真的數組以符合使用習慣，可以使用 GetRows 方法將 Recordset 中的記錄復制到二維數組中。第一個下標標識字段，第二個下標標識記錄編號，下標編號從0開始。GetRows獲得的數組是倒過來的，需要轉置一次才符合使用習慣，可以實現自定義轉置函數，可以用工作表函數Application.WorksheetFunction.Transpose。需要注意的是，工作表轉置函數Transpose只能處理65536行數據，且無法處理Null值。Recordset 對象 轉成數組的完整代碼如下：
Sub 轉換1()Dim objcnn As Object, sql$, arrApplication.ScreenUpdating = FalseSet objcnn = CreateObject("adodb.connection")objcnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=Yes';Data Source=" & ThisWorkbook.FullNamesql = "select * from [數據庫$A1:D]"arr = objcnn.Execute(sql, , 1).GetRowsarr = transpose(arr) '轉置，也可用:Application.WorksheetFunction.TransposeWith Worksheets("結果集").UsedRange.ClearContents.Range("a2").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1) = arrEnd Withobjcnn.CloseSet obcnn = NothingApplication.ScreenUpdating = True End Sub Function transpose(drr) '自定義轉置函數Dim brr(), L1&, U1&, L2&, U2&L1 = LBound(drr): U1 = UBound(drr)L2 = LBound(drr, 2): U2 = UBound(drr, 2)ReDim brr(L2 To U2, L1 To U1)For i = L1 To U1For j = L2 To U2If IsNull(drr(i, j)) Then drr(i, j) = ""brr(j, i) = drr(i, j)NextNexttranspose = brr End Function7. 正則表達式
據說 正則表達式（Regular Expression）源于神經生物科學家，想想也是挺神奇的事。正則表達式絕對是匹配字符串的王者，很復雜的查詢條件，都能寫在一個模式匹配里面。匹配某類字符串或某種字符串組織規則時，正則表達式尤為好用。通過給定一個正則表達式和另一個字符串，可以實現兩個目的：
正則表達式由普通字符和元字符組成。普通字符包括大小寫字母、數字、下劃線或漢字等，而元字符是事先規定的符號，具有特殊的含義，了解了元字符的含義，正則表達式基本上就入門了。下面的元字符是我從網上復制的， VBA的正則表達式不支持其中的少量元字符，比如預查貌似就不支持，使用時加以區分即可。
| \ | 將下一個字符標記符、或一個向后引用、或一個八進制轉義符。例如，“\n”匹配\n。“\n”匹配換行符。序列“\”匹配“\”而“(”則匹配“(”。即相當于多種編程語言中都有的“轉義字符”的概念。 |
| ^ | 匹配輸入字行首。如果設置了 RegExp 對象的 Multiline 屬性，^也匹配“\n”或“\r”之后的位置。 |
| $ | 匹配輸入行尾。如果設置了 RegExp 對象的 Multiline 屬性，$也匹配“\n”或“\r”之前的位置。 |
| * | 匹配前面的子表達式任意次。例如，zo*能匹配“z”，也能匹配“zo”以及“zoo”。*等價于{0,}。 |
| + | 匹配前面的子表達式一次或多次(大于等于1次）。例如，“zo+”能匹配“zo”以及“zoo”，但不能匹配“z”。+等價于{1,}。 |
| ? | 匹配前面的子表達式零次或一次。例如，“do(es)?”可以匹配“do”或“does”。?等價于{0,1}。 |
| {n} | n是一個非負整數。匹配確定的n次。例如，“o{2}”不能匹配“Bob”中的“o”，但是能匹配“food”中的兩個o。 |
| {n,} | n是一個非負整數。至少匹配n次。例如，o{2,}不能匹配“Bob”中的o，但能匹配“foooood”中的所有o。o{1,}等價于o+。o{0,}則等價于o*。 |
| {n,m} | m和n均為非負整數，其中n<=m。最少匹配n次且最多匹配m次。例如，“o{1,3}”將匹配“fooooood”中的前三個o為一組，后三個o為一組。o{0,1}等價于o?。請注意在逗號和兩個數之間不能有空格。 |
| ? | 當該字符緊跟在任何一個其他限制符(*,+,?，{n}，{n,}，{n,m})后面時，匹配模式是非貪婪的。非貪婪模式盡可能少地匹配所搜索的字符串，而默認的貪婪模式則盡可能多地匹配所搜索的字符串。例如，對于字符串“oooo”，“o+”將盡可能多地匹配“o”，得到結果[“oooo”]，而“o+?”將盡可能少地匹配“o”，得到結果 [‘o’, ‘o’, ‘o’, ‘o’] |
| . | 匹配除\n和\r之外的任何單個字符。要匹配包括\n和\r在內的任何字符，請使用像[\s\S]的模式。 |
| (pattern) | 匹配 pattern 并獲取這一匹配。所獲取的匹配可以從產生的 Matches 集合得到，在 VBScript 中使用 SubMatches 集合，在 JScript 中則使用$0…...$9屬性。要匹配圓括號字符，請使用\(或\)。 |
| (?:pattern) | 非獲取匹配，匹配 pattern 但不獲取匹配結果，不進行存儲供以后使用。這在使用或字符(|)來組合一個模式的各個部分時很有用。例如industr(?:y|ies)就是一個比 industry|industries 更簡略的表達式。 |
| (?=pattern) | 非獲取匹配，正向肯定預查，在任何匹配 pattern 的字符串開始處匹配查找字符串，該匹配不需要獲取供以后使用。例如，Windows(?=95|98|NT|2000)能匹配 “Windows2000”中的“Windows”，但不能匹配“Windows3.1”中的“Windows”。預查不消耗字符，也就是說，在一個匹配發生后，在最后一次匹配之后立即開始下一次匹配的搜索，而不是從包含預查的字符之后開始。 |
| (?!pattern) | 非獲取匹配，正向否定預查，在任何不匹配 pattern 的字符串開始處匹配查找字符串，該匹配不需要獲取供以后使用。例如“Windows(?!95 |
| (?<=pattern) | 非獲取匹配，反向肯定預查，與正向肯定預查類似，只是方向相反。例如，“(?<=95 |
| (?<!patte_n) | 非獲取匹配，反向否定預查，與正向否定預查類似，只是方向相反。例如“(?<!95 |
| x|y | 匹配x或y。例如，“z |
| [xyz] | 字符集合。匹配所包含的任意一個字符。例如，“[abc]”可以匹配“plain”中的“a”。 |
| [^xyz] | 負值字符集合。匹配未包含的任意字符。例如，[^abc]可以匹配 “plain” 中的 “plin” 任一字符。 |
| [a-z] | 字符范圍。匹配指定范圍內的任意字符。例如，[a-z]可以匹配a到z范圍內的任意小寫字母字符。 注：只有連字符在字符組內部時,并且出現在兩個字符之間時,才能表示字符的范圍; 如果出字符組的開頭,則只能表示連字符本身. |
| [^a-z] | 負值字符范圍。匹配任何不在指定范圍內的任意字符。例如，[^a-z]可以匹配任何不在a 到z范圍內的任意字符。 |
| \b | 匹配一個單詞的邊界，也就是指單詞和空格間的位置（即正則表達式的“匹配”有兩種概念，一種是匹配字符，一種是匹配位置，這里的\b就是匹配位置的）。例如，er\b可以匹配 “never” 中的 “er”，但不能匹配 “verb” 中的 “er”；\b1_可以匹配 “1_23” 中的 “1_”，但不能匹配 “21_3” 中的 “1_”。 |
| \B | 匹配非單詞邊界。er\B能匹配 verb 中的 er，但不能匹配 never 中的 er。 |
| \cx | 匹配由x指明的控制字符。例如，\cM匹配一個Control-M或 回車符。x的值必須為A-Z或a-z之一。否則，將c視為一個原義的c字符。 |
| \d | 匹配一個數字字符。等價于[0-9]。grep 要加上-P，perl 正則支持 |
| \D | 匹配一個非數字字符。等價于[^0-9]。grep要加上-P，perl正則支持 |
| \f | 匹配一個換頁符。等價于\x0c和\cL。 |
| \n | 匹配一個換行符。等價于\x0a和\cJ。 |
| \r | 匹配一個回車符。等價于\x0d和\cM。 |
| \s | 匹配任何不可見字符，包括空格、制表符、換頁符等等。等價于[ \f\n\r\t\v]。 |
| \S | 匹配任何可見字符。等價于[^ \f\n\r\t\v]。 |
| \t | 匹配一個制表符。等價于\x09和\cI。 |
| \v | 匹配一個垂直制表符。等價于\x0b和\cK。 |
| \w | 匹配包括下劃線的任何單詞字符。類似但不等價于[A-Za-z0-9_]，這里的 “單詞” 字符使用Unicode字符集。 |
| \W | 匹配任何非單詞字符。等價于[^A-Za-z0-9_]。 |
| \xn | 匹配n，其中n為十六進制轉義值。十六進制轉義值必須為確定的兩個數字長。例如，\x41匹配A。\x041則等價于\x04&1。正則表達式中可以使用ASCII編碼。 |
| \num | 匹配num，其中num是一個正整數。對所獲取的匹配的引用。例如，(.)\1匹配兩個連續的相同字符。 |
| \n | 標識一個八進制轉義值或一個向后引用。如果\n之前至少n個獲取的子表達式，則n為向后引用。否則，如果n為八進制數字(0-7)，則n為一個八進制轉義值。 |
| \nm | 標識一個八進制轉義值或一個向后引用。如果\nm之前至少有nm個獲得子表達式，則nm為向后引用。如果\nm之前至少有n個獲取，則n為一個后跟文字m的向后引用。如果前面的條件都不滿足，若n和m均為八進制數字(0-7)，則\nm將匹配八進制轉義值nm。 |
| \nml | 如果n為八進制數字(0-7)，且m和l均為八進制數字(0-7)，則匹配八進制轉義值nml。 |
| \un | 匹配n，其中n是一個用四個十六進制數字表示的Unicode字符。例如，\u00A9匹配版權符號（©）。 |
| \p{P} | 小寫 p 是 property 的意思，表示 Unicode 屬性，用于 Unicode 正表達式的前綴。中括號內的P表示Unicode 字符集七個字符屬性之一：標點字符。 其他六個屬性： L：字母； M：標記符號（一般不會單獨出現）； Z：分隔符（比如空格、換行等）； S：符號（比如數學符號、貨幣符號等）； N：數字（比如阿拉伯數字、羅馬數字等）； C：其他字符。 *注：此語法部分語言不支持，例：JavaScript。 |
| \< | 匹配詞（word）的開始（\<）和結束（\>）。例如正則表達式\ <the\> 能夠匹配字符串 “for the wise” 中的 “the”，但是不能匹配字符串 “otherwise” 中的 “the”。注意：這個元字符不是所有的軟件都支持的。 |
| \> | |
| ( ) | 將( 和 ) 之間的表達式定義為“組”（group），并且將匹配這個表達式的字符保存到一個臨時區域（一個正則表達式中最多可以保存9個），它們可以用 \1 到\9的符號來引用。 |
| | | 將兩個匹配條件進行邏輯或（Or）運算。例如正則表達式(him|her) 匹配 it belongs to him 和it belongs to her，但是不能匹配 it belongs to them.。注意：這個元字符不是所有的軟件都支持的。 |
示例：
1.電話號碼：("^(\d{3,4}-)\d{7,8}$") 格式：xxx/xxxx-xxxxxxx/xxxxxxxx；
2.手機號碼："^1[3|4|5|7|8][0-9]{9}$"；
正則表達式對象只有 Replace、Test 和 Execute 三個方法，Pattern、Global、Ignorecase和Multiline四個屬性和Matches集合，半個小時就能搞清楚個大概，本論壇（ExcelHome）有很多正則表達式的教程，這里不再贅敘。
為實現2.1節相同的查詢結果，可用代碼：
Sub 查詢10()Dim arr, brr, i&, j&, k&, reg As ObjectApplication.ScreenUpdating = Falsearr = Worksheets("數據庫").Range("a1").CurrentRegionReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))For i = 1 To UBound(arr, 2): brr(1, i) = arr(1, i): Next '存儲原標題j = 2Set reg = CreateObject("vbscript.regexp") '創建正則表達式對象reg.Pattern = "和目1" '匹配模式，正則表達式的核心所在，多練習才能掌握For i = 2 To UBound(arr) '查詢條件，用正則表達式匹配If reg.test(arr(i, 2)) = True And arr(i, 3) = "流量套餐2" And arr(i, 4) = "放心用5" ThenFor k = 1 To UBound(arr, 2): brr(j, k) = arr(i, k): Nextj = j + 1End IfNextWith Worksheets("結果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithSet reg = NothingApplication.ScreenUpdating = True End Sub這樣看，貌似正則表達式也沒什么特殊表現。我們假如要查詢手機號最后一位數字是8，倒數第二、三位數字是3、6、9中的數字，用正則表達式就能體現優勢了，只需要reg.Pattern = "[369]{2}8$"，對手機號碼字段進行匹配即可：
Sub 查詢11()Dim arr, brr, i&, j&, k&, reg As ObjectApplication.ScreenUpdating = Falsearr = Worksheets("數據庫").Range("a1").CurrentRegionReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))For i = 1 To UBound(arr, 2): brr(1, i) = arr(1, i): Nextj = 2Set reg = CreateObject("vbscript.regexp")reg.Pattern = "[369]{2}8$"For i = 2 To UBound(arr)If reg.test(arr(i, 1)) ThenFor k = 1 To UBound(arr, 2): brr(j, k) = arr(i, k): Nextj = j + 1End IfNextWith Worksheets("結果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithSet reg = NothingApplication.ScreenUpdating = True End Sub更詳細的正則學習帖子：《正則表達式入門與提高—VBA平臺的正則學習參考資料》，如下圖 >> 點擊前往
8.字典和哈希表
上述各種方法既能精確查詢，也能模糊查詢，已經足夠使用。如果配合使用數組，幾十萬行的數據查詢，速度也是相當快了。但有一個缺點，即每次查詢都需要循環整個數據集，在某些情況下，比如多重循環，那循環計算量相當大。這是一個問題。如果有一種方法，給定一個查詢關鍵字，一步就能定位到需要的數據位置，那就能節約很多時間。理論上是能一步到位的。如著名的MD5算法，碰撞概率是2^256分之一（碰撞就是給定不相同的兩個字符串，散列函數映射出來的數字相同），因此只要定義一個足夠大的數組，用該字符串的映射值作為數組下標位置存放該字符串在數組中，那么，只要給定查詢關鍵詞，就能計算出唯一的數字，用該數組作為數組下標，那么總能一步到位找到該位置存儲的數據，而無需循環。
解決上述問題的是一種叫 哈希表 的數據結構，這種表中的每個元素都由鍵和數據兩部分組成，以數組的形式存儲。哈希表不使用鍵作為數組的下標（太浪費空間了），而是利用某種散列函數將關鍵詞（鍵）轉換（專業術語叫映射）為數組的下標，并用此下標的數組空間存儲數據，這樣建立的數組空間不會占用太多空余空間。詳細內容可自行百度學習，也可看看《老兵新傳 Visual Basic核心編程及通用模塊開發》3.3節：哈希表，（P53，2012年8月第一版）。
8.1 字典
哈希表的特性是精確查詢，而不適合模糊查詢，因為不同的查詢關鍵詞映射出來的數字相差甚遠，根本不可能給出明確的位置指向。據說字典也是這樣一種散列函數的產物，假如給定一個完整的手機號碼（精確查詢），就能 “一步到位” 的找到需要的位置，而無需循環，而如果只給個手機尾號（模糊查詢），就要循環整個字典了。字典是VBA對象，循環字典遠不如循環數組速度快，模糊查詢還是繼續用數組吧。
字典可用于高效地多次精確查詢數據（只查詢一次的話，用字典也沒有意義，因為需要循環數組把數據放進字典），或用于去重復。假如我們要從幾十萬個電話號碼中查詢客戶資料，只要把這些客戶資料或資料的位置存儲在字典中，就能建立高效地查詢系統。字典的教程，論壇中有很多精彩的帖子，這里不再贅敘，推薦藍版一貼：http://club.excelhome.net/thread-868892-1-1.html，本帖只提供字典應用的一個簡單代碼：
Sub 查詢12()Dim i&, k, arr, d As Object, reg As Objectarr = Worksheets("數據庫").Range("a1").CurrentRegionSet d = CreateObject("scripting.dictionary") '創建字典對象For i = 1 To UBound(arr) '把數據裝載到字典。數據量巨大時，可只存儲數據所在行號d(arr(i, 1)) = arr(i, 2) & "/" & arr(i, 3) & "/" & arr(i, 4)Nextk = Application.InputBox("請輸入查詢的手機號碼", Type:=1) '手機號是數字If k = False Then Exit Sub '輸入框點擊取消時返回FalseSet reg = CreateObject("vbscript.regexp") ' reg.Pattern = "^(?:\+86)?1[34578]\d{9}$"reg.Pattern = "^1[34578]\d{9}$" '判斷手機號碼是否有誤。非必要！只是復習一下正則。If reg.test(k) = False Then MsgBox "手機號碼輸入有誤": Exit SubIf d.exists(k) ThenMsgBox k & "用戶 套餐：" & String(2, vbNewLine) & d(k)ElseMsgBox "沒有查詢到數據"End IfSet d = NothingSet reg = Nothing End Sub8.2 哈希表
剛才已經介紹過了，散列函數，也譯為"哈希"（Hash），就是把任意長度的輸入，通過散列算法，映射成固定長度的輸出。著名的散列算法有MD5、SHA1、CRC32等。字典也應該是散列函數的產物，因字典是商業產品，需要考慮經濟性（占用更是資源）、易用性、穩定性，在速度上可能會有所折扣，在幾十萬行數據的情況下已經足夠，但如果數據量更大時，則會顯得稍微慢一些，于是在處理特殊情況時，有些朋友會利用散列函數的原理和算法，自定義自己的字典來處理，這樣在速度上更上一層樓。自定義字典的關鍵是構造哈希函數和解決碰撞問題。散列函數的算法很復雜，但那是數學家的事，而自定義字典（或哈希表）則是簡單的事，主要是利用數學家和計算機科學家的研究結論解決碰撞問題，往往幾十句代碼就能做出可用的哈希表。
上邊提到的書中有內容是介紹哈希表的原理的，可以先看看。論壇有不少自定義的字典帖，例如：http://club.excelhome.net/thread-1372101-1-1.html，利用動態鏈接庫"ntdll.dll" 中的函數"RtlComputeCrc32"（即CRC32）作為散列函數。RtlComputeCrc32返回一個32位的長整數，碰撞概率約2^32分之一，但是計算速度比MD5快很多，是一種廉價而高效的算法，基本上也能滿足運用需求。代碼證返回的32位的長整數跟&H7FFFFFFF按位與，是把返回值的最高位置為0，因為&H7FFFFFFF=01111111111111111111111111111111，這樣就能保證是正數了（對VBA來說，Long數據類型最高位為1時是負數，負數 mod 哈希表的大小是負數，負數不便作為數組的下標）。這里不再舉例，感興趣的可以去研究一下，也許哪天用得到呢。
CRC32的算法VBA代碼沒有，但MD5的算法代碼卻很多，這里復制一份讓大家切身體會一下。代碼源于網絡，感謝原作者。
（附件）
9.相似度計算
我們在百度查詢框中輸入一個關鍵詞，為什么總能找到相關性很高的結果呢？這涉及到相似度計算問題。計算字符串相似度的算法有歐幾里得距離、海明距離、杰卡德距離、編輯距離、KMP算法等等，商用的漢語相似度算法往往很復雜，要涉及到字形、讀音等各種因素，這里只簡單說說編輯距離的算法。
編輯距離的算法是首先由俄國科學家 Levenshtein 提出的，故又叫 Levenshtein距離，指的是兩個字符串之間，由一個轉換成另一個所需的最少編輯操作次數，許可的編輯操作包括將一個字符替換成另一個字符，插入一個字符，刪除一個字符。算法原理在《編程之美》3.3節 計算字符串的相似度，（P230，2008年3月第一版）有介紹，網上的資料更多，
例如：https://www.cnblogs.com/sumuncle/p/5632032.html，參照評論3的代碼（源代碼貌似有些錯誤，我沒有完全按原義改），把它改為完整的VBA代碼如下，可供參考：
Function Levenshtein(str1 As String, str2 As String) As DoubleDim len1&, len2&, i&, j&, dpIf str1 = str2 Then Levenshtein = 1: Exit Functionlen1 = Len(str1): len2 = Len(str2)ReDim dp(len1 + 1, len2 + 1)For i = 0 To len1: dp(i, 0) = i: NextFor i = 0 To len2: dp(0, i) = i: NextFor i = 1 To len1For j = 1 To len2If Mid(str1, i, 1) = Mid(str2, j, 1) Thendp(i, j) = dp(i - 1, j - 1)Elsedp(i, j) = dp(i - 1, j - 1) + 1 '替換操作End If ' dp(i - 1, j) + 1 刪除操作 dp(i, j - 1) + 1 插入操作dp(i, j) = Application.WorksheetFunction.min(dp(i, j), dp(i - 1, j) + 1, dp(i, j - 1) + 1)NextNextLevenshtein = 1 - dp(len1, len2) / Application.WorksheetFunction.Max(len1, len2) End Function10. 其他方法
工作表函數MATCH， FIND，SEARCH等也可以在 VBA 中使用來查詢，工作表函數只要使用Application.WorksheetFunction為前綴即可，但這些都是非主流用法，略去不講了。
11. 查詢過程的效率問題
上面的各種技術只是解決了查詢和匹配問題，還有輸出問題效率問題需要解決。如果查詢數據集龐大，比如有百萬行數據，就需要注意查詢過程中的效率問題，程序設計不好，會嚴重影響運行效率，后果就是體驗效果不佳。造成運行效率低下的原因除了程序代碼的問題外，還有兩個原因：多余的顯示和多余的查詢。
11.1 多余的顯示
一般創建的查詢系統是在窗體中設置一個TEXTBOX查詢框，然后運用Change事件根據輸入值自動查詢并顯示符合條件的數據子集。通過分析得知，當我們輸入的查詢關鍵詞很少時，比如一個字符時，肯定會匹配絕多部分數據，但這些數據都不是最終想要的結果，如果我們把這些數據都顯示出來，會造成極大地輸出效率問題，因為向列表控件（Listbox、Listview等）添加數據并顯示出來，是低效的。同時也是一種浪費，因為這么龐大的結果集沒法看，只能導出到文件另行處理。多余的顯示可以用分頁技術解決，減輕輸出到顯示的壓力，即每次只顯示一部分結果，如果確有需要，再逐步顯示剩余的數據。
11.1.1 使用 ADO 查詢的分頁技術。
我們可新建一個窗體，并初始化：
Private Sub UserForm_Initialize()Dim sql$, i&, j&, col&, a()With Sheet2col = .Range("A1").CurrentRegion.Columns.Count '列數ReDim a(col - 1)For i = 0 To UBound(a)a(i) = .Columns(i + 1).ColumnWidth * 10 '創建Listview列寬數據NextEnd WithSet cnn = CreateObject("adodb.connection")Set rs0 = CreateObject("adodb.recordset")cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=Yes';Data Source=" & ThisWorkbook.FullNamesql = "select * from [數據庫$A1:D] where 1<>1" '只要標題，不要數據rs0.Open sql, cnn, 1, 3With ListView1.View = lvwReport.FullRowSelect = True.Gridlines = TrueFor i = 0 To rs0.Fields.Count - 1If i > 0 Then.ColumnHeaders.Add , , rs0.Fields(i).Name, a(i), lvwColumnCenterElse.ColumnHeaders.Add , , rs0.Fields(i).Name, a(i)End IfNext iEnd WithLabel2 = "準備就緒"模糊查詢.SetFocus End Sub在文本框“模糊查詢”的Change事件中創建查詢語句，根據用戶輸入內容動態查詢數據。
注意，rst是一個公共 Recordset 對象，用來存儲查詢后的結果集，然后調用 “下一頁” 子過程顯示第一頁：
Private Sub 模糊查詢_Change()Dim sql$, temp$, i&, j&, s$Set rst = CreateObject("adodb.recordset")temp = 模糊查詢.Textsql = "select * from [數據庫$A1:D]"If temp <> "" Then '模糊查詢.Text不為空For i = 0 To rs0.Fields.Count - 1 '逐個字段,從0開始循環結果集全部列s = s & " or " & rs0.Fields(i).Name & " like '%" & temp & "%'" '查詢字符串Next isql = sql & " where " & Mid(s, 4)End Ifrst.Open sql, cnn, 1, 3Call 下一頁 End Sub分頁代碼包括顯示上一頁和下一頁
算法代碼如下
Private Sub 下一頁()Dim i&, j&If rst.RecordCount = 0 Then Label2.Caption = "共找到 0 條記錄": ListView1.ListItems.Clear: Exit SubLabel2.Caption = "共找到 " & rst.RecordCount & " 條記錄"If rst.EOF Then MsgBox "已顯示所有數據": Exit SubIf rst.BOF Then rst.Move ListView1.ListItems.Count + 1 With ListView1.ListItems.ClearDo While Not rst.EOFi = i + 1If i > 10 Then Exit Do '每次顯示10條.ListItems.Add , , rst.Fields(0).ValueFor j = 1 To rst.Fields.Count - 1.ListItems(i).SubItems(j) = rst.Fields(j).ValueNext jrst.MoveNextLoopEnd With End Sub Private Sub 上一頁()Dim i&, j&If rst.RecordCount = 0 Then Label2.Caption = "共找到 0 條記錄": ListView1.ListItems.Clear: Exit SubLabel2.Caption = "共找到 " & rst.RecordCount & " 條記錄"If rst.BOF Then MsgBox "已顯示所有數據": Exit Subrst.Move -(ListView1.ListItems.Count + 10) '每次倒退10條(顯示多少條就倒退多少條)If rst.BOF Then MsgBox "已顯示所有數據": Exit SubWith ListView1.ListItems.ClearDo While Not rst.EOFi = i + 1If i > 10 Then Exit Do '每次顯示10條.ListItems.Add , , rst.Fields(0).ValueFor j = 1 To rst.Fields.Count - 1.ListItems(i).SubItems(j) = rst.Fields(j).ValueNext jrst.MoveNextLoopEnd With End Sub使用 ADO 方法的好處是，Recordset 對象會記住數據移動到哪一行，不需要你去控制。但有時候不適合使用 ADO 技術，因為數據比較亂，或者不規范，這時候就得使用數組的方式。
11.1.2 使用數組的分頁技術
同樣，創建一個窗體并初始化。這里drr是數據源數組，crr是保存查詢結果的數組，都是模塊級公共變量，方便不同過程調用。
Private Sub UserForm_Initialize()Dim i&, aWith Sheet2drr = .Range("A2").CurrentRegionReDim a(UBound(drr, 2) - 1)For i = 0 To UBound(a)a(i) = .Columns(i + 1).ColumnWidth * 10NextEnd WithWith ListView1.View = lvwReport.FullRowSelect = True.Gridlines = TrueFor i = 1 To UBound(drr, 2)If i > 1 Then.ColumnHeaders.Add , , drr(1, i), a(i - 1), lvwColumnCenterElse.ColumnHeaders.Add , , drr(1, i), a(i - 1)End IfNext iEnd WithLabel2 = "準備就緒"模糊查詢.SetFocus End Sub在文本框“模糊查詢”的Change事件中創建查詢語句，根據用戶輸入內容動態查詢數據。
注意代碼中的注釋說明。Preserve運算效率比較低，其實可以每次把維數擴展100甚至1000，這樣就能減少Preserve的使用次數，同時也不會浪費多少數組空間。
當然也可以定義一個跟數據源數組一樣大小的數組來保存查詢結果，這樣就不需要Preserve和轉置，效率更高。也可以定義一個跟數據源數組行數一樣多的數組，只保存符合條件的數據的行號，這樣查詢結果的保存會更輕松。待需要輸出時根據行號可一步到位地找到數據行。這個代碼可自行完成。
Private Sub 模糊查詢_Change()Dim txt$, i&If IsEmpty(drr) Then Exit Subtxt = 模糊查詢.TextIf Len(txt) = 0 Then Exit Subcnt = 0 '記錄符合查詢條件的數據的條數pos = 0 '記錄每次輸出之后crr數組的位置ReDim crr(1 To 4, 1 To 1) '每次查詢都需要重定義crr。For i = 2 To UBound(drr)If InStr(drr(i, 1) & "/" & drr(i, 2) & "/" & drr(i, 3) & "/" & drr(i, 4), txt) Thenu = UBound(crr, 2)For j = 1 To 4crr(j, u) = drr(i, j)Nextcnt = cnt + 1ReDim Preserve crr(1 To 4, 1 To u + 1)End IfNext ' Preserve效率比較低，其實可以每次把維數擴展100甚至1000， ' 這樣就能減少Preserve的使用次數，也不會浪費多少數組空間。 ' ReDim crr(1 To 4, 1 To 100) ' For i = 2 To UBound(drr) ' If InStr(drr(i, 1) & "/" & drr(i, 2) & "/" & drr(i, 3) & "/" & drr(i, 4), txt) Then ' cnt = cnt + 1 ' If cnt Mod 100 = 0 Then ReDim Preserve crr(1 To 4, 1 To UBound(crr, 2) + 100) ' For j = 1 To 4 ' crr(j, cnt) = drr(i, j) ' Next ' End If ' Next ' 當然也可以定義一個跟數據源數組一樣大小的數組來保存查詢結果， ' 這樣就不需要Preserve和轉置，效率更高。 ' 也可以定義一個跟數據源數組行數一樣多的數組，只保存符合條件的 ' 數據的行號，這樣查詢結果的保存會更輕松。待需要輸出時根據行號 ' 可一步到位地找到數據行。這個代碼可自行完成。crr = transpose(crr)Call 下一頁 End Sub數組的分頁代碼如下：
Private Sub 下一頁()Dim i&, j&, k&If cnt = 0 Then Label2.Caption = "共找到 0 條記錄": ListView1.ListItems.Clear: Exit SubLabel2.Caption = "共找到 " & cnt & " 條記錄"If pos >= cnt Then MsgBox "已顯示所有數據": Exit SubIf pos = 0 Then pos = 1 'Listview中沒有顯示過數據的情形pos為零If pos < 0 Then pos = ListView1.ListItems.Count + 1With ListView1.ListItems.ClearFor i = pos To cntk = k + 1If k > 10 Then Exit For '每次顯示10條.ListItems.Add , , crr(i, 1)For j = 1 To 3.ListItems(k).SubItems(j) = crr(i, j+1)NextNextpos = iEnd With End Sub Private Sub 上一頁()Dim i&, j&If cnt = 0 Then Label2.Caption = "共找到 0 條記錄": ListView1.ListItems.Clear: Exit SubLabel2.Caption = "共找到 " & cnt & " 條記錄"If pos <= 0 Then MsgBox "已顯示所有數據": Exit Subpos = pos - (ListView1.ListItems.Count + 10) '每次倒退10條(顯示多少條就要倒退多少條)If pos <= 0 Then MsgBox "已顯示所有數據": Exit SubWith ListView1.ListItems.ClearFor i = pos To cntk = k + 1If k > 10 Then Exit For '每次顯示10條.ListItems.Add , , crr(i, 1)For j = 1 To 3.ListItems(k).SubItems(j) = crr(i, j+1)NextNextpos = iEnd With End Sub11.2多余的查詢
查詢的過程不一定需要顯示所有數據，有時候也不一定需要查詢所有數據。很多時候我們查詢的結果都是可預知的很小的數據子集，比如查詢某個賬號的資料數據，比如某訂單的商品明細，其結果集都是很小的，因此，在逐步輸入查詢關鍵詞的過程中，根本無需查詢整個數據庫，因為沒有誰會從幾千幾萬行查詢結果中去找自己想要的數據，我們只要查詢滿足條件的100行（或者更少，根據實際情況而定）的數據就可以退出查詢循環，等查詢關鍵詞輸入到足夠多的時候，符合條件的結果集都不會超過限定的行數。當然，為了保險起見，每次只查詢少量數據，可能會導致數據遺漏，還得有一個讓用戶顯示剩余符合條件的結果的功能。
這種技術因為不是查詢整個數據源，且不查詢到最后是不知道有多少數據符合查詢條件的，結果集是未知的，我稱之為動態加載數據，我在 http://club.excelhome.net/thread-1424969-1-1.html 的第七節中已經介紹過，這里再復習一遍吧。
該方法的核心代碼是：
- lv：istView對象，需要新增Listitem的目標對象；
- lngIdx：數據數組的起始查詢位置，動態加載數據；
- lngCount：需要新增滿足查詢條件的Listitem行數；
- lngRowIndex：記錄arrData數組當前位置的全局變量；
示例：
Public Sub AddListItems(lv As ListView, ByVal lngIdx As Long, lngCount As Long)Dim i&, j&, n&, strKey$, lstitem As ListItemIf IsEmpty(arrData) Then Exit SubIf lngIdx < LBound(arrData) Or lngIdx > UBound(arrData) Then Exit SubIf lngCount < 1 Then lngCount = UBound(arrData) '小于1則加載全部txt = 模糊查詢.TextWith lvFor i = lngIdx To UBound(arrData)strKey = arrData(i, 1) & "/" & arrData(i, 2) & "/" & arrData(i, 3) & "/" & arrData(i, 4)If InStr(strKey, txt) Thenn = n + 1’計數器If n > lngCount Then Exit ForSet lstitem = .ListItems.Addlstitem.Text = arrData(i, 1)For j = 2 To UBound(arrData, 2)lstitem.SubItems(j - 1) = arrData(i, j)NextEnd IfNextIf i > UBound(arrData) Then lngRowIndex = i Else lngRowIndex = i + 1End WithIf lngRowIndex >= UBound(arrData) Then Label2 = "數據加載完了" Else Label2 = "滾動鼠標可繼續加載數據……" End Sub調用AddListItems時，只要指定從數據源什么位置開始查詢，并指定查詢多少匹配行即行停止查詢即可。在查詢框中可直接調用：
Private Sub 模糊查詢_Change()ListView1.ListItems.ClearAddListItems ListView1, 2, 20 End Sub要想顯示更多數據，可新建一個命令按鈕，直接調用AddListItems：
Private Sub CommandButton1_Click() '顯示更多AddListItems ListView1, lngRowIndex, 20 End Sub如果想要滾動鼠標中鍵和拖動Listview垂直滾動條也能動態加載數據，只要監聽到這些事件時，調用AddListItems即可，非常方便。要監聽Listview的鼠標事件需要少量 API，窗體初始化時，需要改一下：
Private Sub UserForm_Initialize()Dim i&, aWith Sheet2arrData = .Range("a1").CurrentRegionReDim a(UBound(arrData, 2) - 1)For i = 0 To UBound(a)a(i) = .Columns(i + 1).ColumnWidth * 10NextEnd WithWith ListView1.View = lvwReport.FullRowSelect = True.Gridlines = TrueFor i = 1 To UBound(arrData, 2)If i > 1 Then.ColumnHeaders.Add , , arrData(1, i), a(i - 1), lvwColumnCenterElse.ColumnHeaders.Add , , arrData(1, i), a(i - 1)End IfNextAddListItems ListView1, 2, 10 '初始化時加載10條數據，如有的話，可自行設置LvmPreWndProc = GetWindowLong(.hwnd, GWL_WNDPROC)SetWindowLong .hwnd, GWL_WNDPROC, AddressOf WndProcEnd WithLabel2 = "準備就緒"模糊查詢.SetFocus End Sub注意，退出窗體時，需要還原窗體的窗口函數：
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)SetWindowLong ListView1.hwnd, GWL_WNDPROC, LvmPreWndProc End Sub監聽程序如下：
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function GetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long) As Long Public Declare Function GetScrollRange Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, lpMinPos As Long, lpMaxPos As Long) As Long Public Const SB_VERT = 1 Public Const WM_VSCROLL = &H115 Public Const WM_MOUSEWHEEL = &H20A Public Const GWL_WNDPROC = (-4)Public LvmPreWndProc As Long Public arrData, lngRowIndex As LongPublic Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim lngMinPos As Long, lngMaxPos As LongWith UserForm3Select Case MsgCase WM_VSCROLL '拖動Listview垂直滾動條GetScrollRange hwnd, SB_VERT, lngMinPos, lngMaxPosIf GetScrollPos(hwnd, SB_VERT) > lngMaxPos - 200 ThenIf lngRowIndex <= UBound(arrData) Then.AddListItems .ListView1, lngRowIndex, 1End IfEnd IfCase WM_MOUSEWHEEL '滾動鼠標中鍵If wParam = &HFF880000 ThenIf lngRowIndex <= UBound(arrData) Then.AddListItems .ListView1, lngRowIndex, 1End IfEnd IfEnd SelectEnd WithWndProc = CallWindowProc(LvmPreWndProc, hwnd, Msg, wParam, lParam) End Function12. 補充
可以這么說，只要不是對所有數據都進行處理，基本上都涉及到查詢問題，要通過查詢操作辨識需要處理的數據。其實密碼也是需要查找的，你的論壇密碼不會明文保存在論壇數據庫，而會計算出MD5保存在數據庫。那樣，就算別人知道你密碼的MD5值也沒有用，因為MD5是不可逆的運算，無法根據MD5倒退出你的密碼明文。看到很多朋友做的登錄系統都保存密碼明文，其實通過MD5運算再保存會安全得多。
有時候文件也需要查詢匹配是否一致。比如 秒傳技術，本質就是MD5算法，網盤或者其他文件服務器會先計算你傳輸文件的MD5，然后跟它數據庫里面的MD5值比對，如果你的文件的MD5在數據庫中存在，你的文件根本不會被傳輸，這就是秒傳。還有，下載軟件也會使用MD5搜索資源，因為每個人保存的文件名可能不同，且比較文件名是不可靠的，同名的文件很大，而通過MD5就能找到確定相同的文件。再分享一個計算文件MD5的代碼，算法是 API 函數，供大家參考：
Option Base 0 Public Declare Sub MD5Init Lib "Cryptdll.dll" (ByVal pContex As Long) Public Declare Sub MD5Final Lib "Cryptdll.dll" (ByVal pContex As Long) Public Declare Sub MD5Update Lib "Cryptdll.dll" (ByVal pContex As Long, ByVal lPtr As Long, ByVal nSize As Long) Public Type MD5_CTXi(1) As Longbuf(3) As Longinc(63) As Bytedigest(15) As Byte End TypePublic cnt As LongPublic Function ConvBytesToBinaryString(bytesIn() As Byte) As StringDim i As LongDim nSize As LongDim strRet As StringnSize = UBound(bytesIn)For i = 0 To nSizestrRet = strRet & Right$("0" & Hex(bytesIn(i)), 2)NextConvBytesToBinaryString = strRet End FunctionPublic Function GetMD5Hash(bytesIn() As Byte) As Byte()Dim ctx As MD5_CTXDim nSize As LongnSize = UBound(bytesIn) + 1MD5Init VarPtr(ctx)MD5Update ByVal VarPtr(ctx), ByVal VarPtr(bytesIn(0)), nSizeMD5Final VarPtr(ctx)GetMD5Hash = ctx.digest End FunctionPublic Function GetMD5Hash_Bytes(bytesIn() As Byte) As StringGetMD5Hash_Bytes = ConvBytesToBinaryString(GetMD5Hash(bytesIn)) End FunctionPublic Function GetMD5Hash_String(ByVal strIn As String) As StringGetMD5Hash_String = GetMD5Hash_Bytes(StrConv(strIn, vbFromUnicode)) End FunctionPublic Function GetMD5Hash_File(ByVal strFile As String) As StringDim lFile As LongDim bytes() As ByteDim lSize As LonglSize = FileLen(strFile)If (lSize) ThenlFile = FreeFileReDim bytes(lSize - 1)Open strFile For Binary As lFileGet lFile, , bytesClose lFileGetMD5Hash_File = GetMD5Hash_Bytes(bytes)End If End FunctionSub Getfd(ByVal pth As String, arr)Dim fso As Object, f, fd, ffSet fso = CreateObject("scripting.filesystemobject")Set ff = fso.getfolder(pth)For Each f In ff.Filescnt = cnt + 1If cnt Mod 1000 = 0 Then ReDim Preserve arr(1 To 6, 1 To UBound(arr, 2) + 1000)arr(1, cnt) = farr(2, cnt) = f.DateCreatedarr(3, cnt) = f.DateLastModifiedarr(4, cnt) = f.Typearr(5, cnt) = Format(f.Size / 1048576, "0.00MB")arr(6, cnt) = GetMD5Hash_File(f)NextFor Each fd In ff.subfolders: Getfd fd, arr: Next End SubFunction transpose(drr)Dim brr(), L1&, U1&, L2&, U2&L1 = LBound(drr): U1 = UBound(drr)L2 = LBound(drr, 2): U2 = UBound(drr, 2)ReDim brr(L2 To U2, L1 To U1)For i = L1 To U1For j = L2 To U2If IsNull(drr(i, j)) Then drr(i, j) = ""brr(j, i) = drr(i, j)NextNexttranspose = brr End FunctionSub AllFiles()Dim pth$, arrApplication.ScreenUpdating = FalseWith Application.FileDialog(msoFileDialogFolderPicker)If .Show = -1 Thenpth = .SelectedItems(1)ElseMsgBox "您沒有選擇任何文件夾！", vbCritical: Exit SubEnd IfEnd Withcnt = 0ReDim arr(1 To 6, 1 To 1000)Getfd pth, arrarr = transpose(arr)With ActiveSheet.UsedRange.Clear.Cells(1, 1) = "文件名稱".Cells(1, 2) = "創建日期".Cells(1, 3) = "修改日期".Cells(1, 4) = "文件類型".Cells(1, 5) = "文件大小".Cells(1, 6) = "MD5 數值".Cells(2, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arrr = .Range("a" & Rows.Count).End(3).Row.Range("a1:f" & r).Borders.LineStyle = xlContinuous.Range("a1:f" & r).Borders.Weight = xlThinEnd WithApplication.ScreenUpdating = TrueMsgBox "文件已全部獲取！點『確定』鍵結束" End Sub計算文件的MD5值 >> 點擊下載
所有示例源碼 >> 點擊下載
13．總結
本帖介紹的查詢技術包括匹配過程和輸出過程。匹配過程最常使用Instr、Like、正則表達和字典，但是 ADO 方式在多人協作環境更常用，因為多人協作的環境基本涉及到數據庫。Range 對象 的Find方法、自動篩選和高級篩選功能也可以方便的使用，如果不追求效率的話。相似度計算在某些場合也是可以使用的。熟悉這些方法對于我們的編程能力的提高應該會有所裨益。
14. 精彩點評
-
網友1：
- 第一是關于正則表達式說明部分，零寬斷言部分，有兩種情況VBA 的正則表達式根本不支持，所以應該從剔除掉。
- 第二點是 ADO 部分，如果數據源是Excel 表的話，數據類型猜測的坑是不可避免的，修改注冊表也是飲鴆止渴的解決方案，Excel 模糊數據類型就是SQL 的大忌。還有就是由于Excel 表沒有索引的概念所有，都是全表掃描select，那么用于分頁的高效語句執行在Excel 里面和數據庫是不同的，本身并沒有意義。
-
作者回復：
- 那個表格是我復制的（打字太慢了），正反預查在VBA中應該也不支持，我檢查過，還有極少量元字符也是不支持的，但最重要的那些元字符沒問題，不會影響正常使用，我就沒有剔除，只提示某些元字符對于VBA無效。每種計算機語言的正則表達式的語法稍有區別，但好在元字符基本是一致的，學會了就能通用了，就跟SQL語句和ADO，基本上到處可用。
- ADO在EXCEL中判斷不規范數據的表格的類型偶有失誤，所以我也說明了在數據規范的表格中的適用性。但數據查詢與匹配，包括但不限于EXCEL，還可以涉及到數據庫的查詢，所以也是可以作為一個知識點的，使用者只要根據情況靈活使用即可。
-
網友2：
- 建議每個小結都附帶一個單獨的源代碼表格。最好程序里沒有中文，不然我們的英文office打不開；
-
作者回復：
- 自己把代碼復制到文件中，親身實踐一下，才能加強理解。
總結
以上是生活随笔為你收集整理的VBA各种查询方法介绍和应用举例的全部內容，希望文章能夠幫你解決所遇到的問題。
- 上一篇： 通过网络地址进行真机调试
- 下一篇： mybatis plus实现多表分页条件