VBA各种查询方法介绍和应用举例
目錄
- 前言
- 1 Range對象的Find方法
- 2. Range 對象的 Filter 方法
- 2.1 AutoFilte自動篩選
- 2.2 AdvancedFilter 高級篩選
- 3.Instr 函數(shù)
- 4.Like 運(yùn)算符
- 5.SQL 查詢語句
- 6. ADO Recordset 對象 Find 方法和 Filter 屬性
- 6.1 Find 方法
- 6.2 Filter 屬性
- 7. 正則表達(dá)式
- 8.字典和哈希表
- 8.1 字典
- 8.2 哈希表
- 9.相似度計(jì)算
- 10. 其他方法
- 11. 查詢過程的效率問題
- 11.1 多余的顯示
- 11.1.1 使用 **ADO** 查詢的分頁技術(shù)。
- 11.1.2 使用數(shù)組的分頁技術(shù)
- 11.2多余的查詢
- 12. 補(bǔ)充
- 13．總結(jié)
- 14. 精彩點(diǎn)評
前言
查詢（或匹配）是程序設(shè)計(jì)中最重要的功能之一，只有用好查詢功能，才能從紛繁復(fù)雜的數(shù)據(jù)中找到符合要求的數(shù)據(jù)子集，提高工作效率。查詢分為模糊查詢和精確查詢，只匹配一個字符串中的部分字符串就是模糊查詢，完全一致則是精確批量，例如字符串“excelhome”，用包含“excel”的條件進(jìn)行查詢是模糊查詢，用等于“excelhome” 的條件進(jìn)行查詢則是精確查詢。查詢的方法多種多樣，本貼總結(jié)了10種VBA查詢方法，分享給大家，以博大方之家一笑，或者給初學(xué)者提供一點(diǎn)入門知識，不敢說什么拋磚引玉，因?yàn)槲也皇菕佫D(zhuǎn)的專家，不求引玉，只要不引來石頭就夠了。
1 Range對象的Find方法
Find方法跟在工作表中按Ctrl+F查詢的效果一致，如果找到匹配單元格，該方法返回一個Range對象，沒找到則返回Nothing。語法為：
表達(dá)式.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)表達(dá)式是一個代表 Range 對象的變量。參數(shù)說明如下：
| What | 必選 | Variant | 要搜索的數(shù)據(jù)。可為字符串或任意 Microsoft Excel 數(shù)據(jù)類型。 |
| After | 可選 | Variant | 表示搜索過程將從其之后開始進(jìn)行的單元格。此單元格對應(yīng)于從用戶界面搜索時的活動單元格的位置。請注意：After 必須是區(qū)域中的 單個單元格。要記住搜索是從該單元格之后開始的；直到此方法繞回到此單元格時，才對其進(jìn)行搜索。如果不指定該參數(shù)，搜索將從區(qū)域的左上角的單元格之后開始。 |
| LookIn | 可選 | Variant | 指定查找的范圍類型，可以為以下常量之一：xlValues、xlFormulas或者xlComments，默認(rèn)值為xlFormulas。 |
| LookAt | 可選 | Variant | 可為以下 XlLookAt 常量之一：xlWhole 或 xlPart。 |
| SearchOrder | 可選 | Variant | 可為以下 XlSearchOrder 常量之一：xlByRows 或 xlByColumns。 |
| SearchDirection | 可選 | XlSearchDirection | 搜索的方向。 |
| MatchCase | 可選 | Variant | 如果為 True，則搜索區(qū)分大小寫。默認(rèn)值為 False。 |
| MatchByte | 可選 | Variant | 只在已經(jīng)選擇或安裝了雙字節(jié)語言支持時適用。如果為 True，則雙字節(jié)字符只與雙字節(jié)字符匹配。如果為 False，則雙字節(jié)字符可與其對等的單字節(jié)字符匹配。 |
| SearchFormat | 可選 | Variant | 搜索的格式。 |
常用的參數(shù)為What和LookAt，我們舉例說明。我們要在a2:a1550單元格中查找包含“132”的單元格（模糊查詢），并把字符顏色改為紅色，代碼如下：
Sub 查詢1()Dim c As Range, firstAddress$With Worksheets("數(shù)據(jù)庫").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參數(shù)，程序從區(qū)域的左上角的單元格之后開始查詢，即A3開始查詢，并在程序最后返回到A2，才對A2單元格進(jìn)行查找。這里FindNext是繼續(xù)由 Find方法開始的搜索。查找匹配相同條件的下一個單元格，并返回表示該單元格的 Range 對象。
Find 方法是直接在 Range 對象上操作，因此效率不高，在查詢量很少的時候可以用。如果查詢數(shù)量巨大，最好把數(shù)據(jù)放在數(shù)組中進(jìn)行處理。
2. Range 對象的 Filter 方法
2.1 AutoFilte自動篩選
AutoFilter就是篩選，可使用多個條件進(jìn)行查詢，可精確查詢和模糊查詢，并可使用通配符和比較運(yùn)算符。通配符?表示 任何單一字符，* 表示零個或多個字符。語法：
表達(dá)式.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown)表達(dá)式是一個Range對象。
參數(shù)說明如下：
| Field | 可選 | Variant | 相對于作為篩選基準(zhǔn)字段（從列表左側(cè)開始，最左側(cè)的字段為第一個字段）的字段的整型偏移量。 |
| Criterial | 可選 | Variant | 篩選條件（一個字符串；例如，“101”）。使用“=”可查找空字段，或者使用“<>”查找非空字段。如果省略該參數(shù)，則搜索條件為 All。如果將 Operator 設(shè)置為 xlTop10Items，則 Criteria1 指定數(shù)據(jù)項(xiàng)個數(shù)（例如，“10”）。 |
| Operator | 可選 | Variant | 指定篩選類型的 XlAutoFilterOperator 常量之一。 |
| Criteria2 | 可選 | Variant | 第二個篩選條件（一個字符串）。與 Criteria1 和 Operator 一起組合成復(fù)合篩選條件。 |
| VisibleDropDown | 可選 | Variant | 如果為 True，則顯示篩選字段的自動篩選下拉箭頭。如果為 False，則隱藏篩選字段的自動篩選下拉箭頭。默認(rèn)值為 True。 |
XlAutoFilterOperator 可選值如下：
| xlAnd | 1 | 條件 1 和條件 2 的邏輯與。 |
| xlBottom10Items | 4 | 顯示最低值項(xiàng)（條件 1 中指定的項(xiàng)數(shù)）。 |
| xlBottom10Percent | 6 | 顯示最低值項(xiàng)（條件 1 中指定的百分?jǐn)?shù)）。 |
| xlFilterCellColor | 8 | 單元格顏色 |
| xlFilterDynamic | 11 | 動態(tài)篩選 |
| xlFilterFontColor | 9 | 字體顏色 |
| xlFilterIcon | 10 | 篩選圖標(biāo) |
| xlFilterValues | 7 | 篩選值 |
| xlOr | 2 | 條件 1 和條件 2 的邏輯或。 |
| xlTop10Items | 3 | 顯示最高值項(xiàng)（條件 1 中指定的項(xiàng)數(shù)）。 |
| xlTop10Percent | 5 | 顯示最高值項(xiàng)（條件 1 中指定的百分?jǐn)?shù)）。 |
需要注意的是，如果忽略全部參數(shù)，此方法僅在指定區(qū)域切換自動篩選下拉箭頭的顯示，不執(zhí)行篩選動作。Criteria1和Criteria2是每一列字段可用的兩個篩選關(guān)鍵詞，最多2個，可用XlAutoFilterOperator的值指定該2個關(guān)鍵詞之間的關(guān)系。如果需要多個字段進(jìn)行篩選，請按順序依次使用該語句。
例如篩選“推薦業(yè)務(wù)1”字段中包含“和目1”、“推薦業(yè)務(wù)2”等于“"流量套餐2” 、“推薦業(yè)務(wù)3”等于“"放心用5”的數(shù)據(jù)并復(fù)制到其他工作表中：
Sub 查詢2()Application.ScreenUpdating = FalseWith Worksheets("數(shù)據(jù)庫").Range("a1:d1550").AutoFilter Field:=2, Criteria1:="*和目1*" '可使用通配符和比較運(yùn)算符模糊查詢.AutoFilter Field:=3, Criteria1:="流量套餐2"’精確查詢.AutoFilter Field:=4, Criteria1:="放心用5"'……可以繼續(xù)增加更多條件Worksheets("結(jié)果集").UsedRange.ClearContents.Copy Worksheets("結(jié)果集").Range("a1").AutoFilter '取消自動篩選End WithApplication.ScreenUpdating = True End Sub代碼均以下圖數(shù)據(jù)集進(jìn)行編寫:
2.2 AdvancedFilter 高級篩選
AdvancedFilter方法基于條件區(qū)域從列表中篩選或復(fù)制數(shù)據(jù)。如果初始選定區(qū)域?yàn)閱蝹€單元格，則使用單元格的當(dāng)前區(qū)域。語法：
表達(dá)式.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)表達(dá)式為一個代表 Range 對象的變量。參數(shù)說明如下：
| Action | 必選 | XlFilterAction | XlFilterAction 的常量之一，用于指定是否就地復(fù)制或篩選列表。xlFilterCopy表示將篩選出的數(shù)據(jù)復(fù)制到新位置，xlFilterInPlace表示保留數(shù)據(jù)不動。 |
| CriteriaRange | 可選 | Variant | 條件區(qū)域。如果省略該參數(shù)，則沒有條件限制。 |
| CopyToRange | 可選 | Variant | 如果 Action 為 xlFilterCopy，則為復(fù)制行的目標(biāo)區(qū)域。否則，忽略該參數(shù)。 |
| Unique | 可選 | Variant | 如果為 True，則只篩選唯一記錄。如果為 False，則篩選符合條件的所有記錄。默認(rèn)值為 False。 |
為實(shí)現(xiàn)2.1節(jié)相同的查詢結(jié)果，CriteriaRange設(shè)置為：
代碼如下：
Sub 查詢3()Application.ScreenUpdating = FalseWorksheets("結(jié)果集").UsedRange.ClearContentsWith Worksheets("數(shù)據(jù)庫").Range("a1:d1550").AdvancedFilter xlFilterCopy, .Range("h1:k2"), Worksheets("結(jié)果集").Range("a1"), FalseEnd WithApplication.ScreenUpdating = True End Sub唯一需要說明的是CriteriaRange參數(shù)。條件區(qū)域至少包含兩行，第一行包含一個或多個列標(biāo)題，是想要在數(shù)據(jù)區(qū)域中篩選的字段，第二行開始包含的是想要獲取的數(shù)據(jù)，可使用通配符，如果要獲取不同的數(shù)據(jù)，可分列多行（不同行的條件是“或”的關(guān)系，同行的條件是“與”的關(guān)系），例如“推薦業(yè)務(wù)3”想查詢“放心用5”或“放心用6”，在下圖的K3單元格中加上“放心用6”，CriteriaRange改為Range("h1:k3")即可。
3.Instr 函數(shù)
以上兩個方法都是針對Range對象的，實(shí)際運(yùn)用中，很多數(shù)據(jù)都不在工作表中，沒有辦法使用上述的方法。其實(shí)，就算數(shù)據(jù)在工作表中，因?yàn)樯鲜龇椒ㄊ菍ο筮M(jìn)行操作，也會嚴(yán)重影響效率，而首先會把數(shù)據(jù)裝進(jìn)數(shù)組之中再行處理。這節(jié)介紹的Instr函數(shù)可以方便快捷的匹配數(shù)組中的數(shù)據(jù)。該函數(shù)返回指定一字符串在另一字符串中最先出現(xiàn)的位置。
語法：
InStr([start, ]string1, string2[, compare])，參數(shù)說明：
| start | 可選參數(shù)。為數(shù)值表達(dá)式，設(shè)置每次搜索的起點(diǎn)。如果省略，將從第一個字符的位置開始。如果 start 包含 Null，將發(fā)生錯誤。如果指定了 compare 參數(shù)，則一定要有 start 參數(shù)。 |
| string1 | 必要參數(shù)。接受搜索的字符串表達(dá)式。 |
| string2 | 必要參數(shù)。被搜索的字符串表達(dá)式。 |
| Compare | 可選參數(shù)。指定字符串比較。如果 compare 是 Null，將發(fā)生錯誤。如果省略 compare，Option Compare 的設(shè)置將決定比較的類型。指定一個有效的LCID (LocaleID) 以在比較中使用與區(qū)域有關(guān)的規(guī)則。 |
compare 參數(shù)可選值為：
| vbUseCompareOption | -1 | 使用 Option Compare 語句設(shè)置執(zhí)行一個比較。 |
| vbBinaryCompare | 0 | 執(zhí)行一個二進(jìn)制比較。 |
| vbTextCompare | 1 | 執(zhí)行一個按照原文的比較。 |
| vbDatabaseCompare | 2 | 僅適用于 Microsoft Access，執(zhí)行一個基于數(shù)據(jù)庫中信息的比較。 |
注意：第一個參數(shù)和第四個參數(shù)可以省略，但如果指定了第四個參數(shù)，第一個參數(shù)也應(yīng)指定。
為實(shí)現(xiàn)2.1節(jié)相同的查詢結(jié)果，可用代碼：
Sub 查詢4()Dim arr, brr, i&, j&, k&Application.ScreenUpdating = Falsearr = Worksheets("數(shù)據(jù)庫").Range("a1").CurrentRegionReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2)) '存放符合查詢條件的結(jié)果，數(shù)組大小跟arr一致'也可用Redim Preserve根據(jù)需要擴(kuò)大數(shù)組，但只能擴(kuò)大最后一維，故需要轉(zhuǎn)置數(shù)組，效率較低For i = 1 To UBound(arr, 2): brr(1, i) = arr(1, i): Next '存儲原標(biāo)題j = 2For i = 2 To UBound(arr) '查詢條件，用Instr函數(shù)匹配字符串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("結(jié)果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithApplication.ScreenUpdating = True End Sub我們可以用InStr(arr(i, 2), “和目1”)的方式查詢數(shù)組元素arr(i, 2)中是否包含"和目1"（模糊查詢），也可以用一個Instr函數(shù)同時精確查詢多個關(guān)鍵詞，例如要“推薦業(yè)務(wù)3”字段中有"放心用5"、“放心用8"或"放心用9”，用InStr(“放心用5/放心用8/放心用9”, arr(i, 4))即可，比用邏輯運(yùn)算符（And，Or等）連接多個條件更方便：arr(i, 4)=“放心用5” Or arr(i, 4)=“放心用8” Or arr(i, 4)=“放心用9” 。
Instr應(yīng)用遠(yuǎn)不僅此，例如想搞個自定義排名，除了可用Application.AddCustomList外，還可以用如Instr(“張三/李四/王五”,姓名)的形式，求得姓名所在位置，然后按這些位置排序即可，可根據(jù)實(shí)際需求應(yīng)用。另外，InStrRev 函數(shù)跟Instr函數(shù)類似，也返回一個字符串在另一個字符串中出現(xiàn)的位置，但從字符串的 末尾 開始查詢。
4.Like 運(yùn)算符
Like運(yùn)算符用來比較兩個字符串，如果跟條件匹配，返回TRUE，否則返回FALSE。語法：
result = string Like patternLike運(yùn)算符跟其他比較運(yùn)算符的區(qū)別是模式匹配，其pattern參數(shù)可以用如下字符：
| ? | 任何單一字符。 |
| * | 零個或多個字符。 |
| # | 任何一個數(shù)字 (0–9)。 |
| [charlist] | charlist.中的任何單一字符。 |
| [!charlist] | 不在 charlist 中的任何單一字符。 |
為實(shí)現(xiàn)2.1節(jié)相同的查詢結(jié)果，可用代碼：
Sub 查詢5()Dim arr, brr, i&, j&, k&Application.ScreenUpdating = Falsearr = Worksheets("數(shù)據(jù)庫").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 '存儲原標(biāo)題j = 2For i = 2 To UBound(arr) '查詢條件，用Like運(yùn)算符匹配字符串，可用通配符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("結(jié)果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithApplication.ScreenUpdating = True End Sub由上可見，使用Like運(yùn)算符的代碼跟使用Instr函數(shù)的代碼幾乎一致，但Like更靈活。
假如我們做一個窗體查詢界面，使用Instr函數(shù)也能實(shí)現(xiàn)查詢，但用Like運(yùn)算符的好處是在查詢框中使用*和?運(yùn)算符，也能使用字符集。例如我們想查詢表格中第一列的手機(jī)號中包括5、7或9的號碼，只需用arr(i, 1) Like "*[579]*"就行了，比Instr更簡潔。
查詢大量數(shù)據(jù)時，為了極大的提高效率，通常會先把數(shù)據(jù)放進(jìn)數(shù)組中再進(jìn)行匹配，故Instr和Like是最常用的查詢方式，我們要多運(yùn)用，熟練于心。
5.SQL 查詢語句
SQL(結(jié)構(gòu)化查詢語言Structured Query Language)是一門ANSI的標(biāo)準(zhǔn)計(jì)算機(jī)語言，用來訪問和操作數(shù)據(jù)庫系統(tǒng)。SQL 語句用于取回和更新數(shù)據(jù)庫中的數(shù)據(jù)。SQL 可與數(shù)據(jù)庫程序協(xié)同工作，比如 MS Access、DB2、Informix、MS SQL Server、Oracle、Sybase 以及其他數(shù)據(jù)庫系統(tǒng)。入門級的SQL語法可花2個小時就學(xué)會，可看 http://www.w3school.com.cn/sql/sql_select.asp 。
SQL語句配合ADO對象，能像操作數(shù)據(jù)庫一樣操作工作表，使得很多時候查詢代碼變得簡單易懂，也易于修改。且SQL語句查詢不用考慮工作表中列的變動（使用數(shù)組的話，如果某些列變動了位置，則需要修改代碼），只需維護(hù)SQL語句即可。SQL語句操作數(shù)據(jù)庫，也能實(shí)現(xiàn)復(fù)雜的匯總功能，如：http://club.excelhome.net/thread-1416073-1-1.html，因此花幾個小時去學(xué)習(xí)還是很劃算的。如果查詢到是數(shù)據(jù)要進(jìn)行超過SQL語法能力的操作，可以用GetRows方法先轉(zhuǎn)成數(shù)組。
為實(shí)現(xiàn)2.1節(jié)相同的查詢結(jié)果，可用代碼：
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 [數(shù)據(jù)庫$A1:D] where 推薦業(yè)務(wù)1 like '%和目1%' and 推薦業(yè)務(wù)2='流量套餐2' and 推薦業(yè)務(wù)3='放心用5'"objrst.Open sql, objcnn, 1, 3With Worksheets("結(jié)果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標(biāo)題.Cells(1, i + 1) = objrst.Fields(i).NameNext.Range("a2").CopyFromRecordset objrst '輸出數(shù)據(jù)End Withobjrst.Closeobjcnn.CloseSet objrst = NothingSet obcnn = NothingApplication.ScreenUpdating = True End Sub注意：在SQL語句中需用%代替*通配符*。
6. ADO Recordset 對象 Find 方法和 Filter 屬性
如果只是查詢并輸出數(shù)據(jù)，使用上一節(jié)的SQL語句足夠了，但是很多時候查詢是為了修改特定的數(shù)據(jù)，且需要多
處修改，如果使用 SQL UPDATE修改，會有諸多不便。首先各個數(shù)據(jù)庫的SQL語法稍有差異；其次UPDATE語
句也更復(fù)雜；還有，使用SQL語句頻繁訪問數(shù)據(jù)庫也是難以實(shí)現(xiàn)的，畢竟一臺計(jì)算機(jī)只能同時服務(wù)幾十個連接，
而使用 ADO Recordset 對象則可以把數(shù)據(jù)放在本地編輯，批量修改好之后再連接數(shù)據(jù)庫更新修改。
6.1 Find 方法
語法：Rst.Find (Criteria, SkipRows, SearchDirection, Start)，Rst 為 Recordset 數(shù)據(jù)集對象。
參數(shù)說明：
| Criteria | 必選 | String 值，包含指定用于搜索的列名、比較操作符和值的語句。 |
| SkipRows | 可選 | Long 值，其默認(rèn)值為零，它指定當(dāng)前行或 Start 書簽的行偏移量以開始搜索。在默認(rèn)情況下，搜索將從當(dāng)前行開始。 |
| SearchDirection | 可選 | SearchDirectionEnum 值，指定搜索應(yīng)從當(dāng)前行開始，還是從搜索方向的下一個有效行開始。如果該值為 adSearchForward，不成功的搜索將在 Recordset 的結(jié)尾處停止。如果該值為 adSearchBackward，不成功的搜索將在 Recordset 的開始處停止。 |
| Start | 可選 | Variant 書簽，用于標(biāo)記搜索的開始位置。 |
一般只用第一個參數(shù)和第二個參數(shù)。在 criteria 中只能指定單列名稱，故不支持多列搜索，想要多列查詢，可用6.2節(jié)中的 Filter 屬性。
Criteria 中的比較操作符可以是>（大于）、<（小于）、=（等于）、>=（大于或等于）、<=（小于或等于）、<>（不等于）或like（模式匹配）。
Criteria 中的值可以是字符串、浮點(diǎn)數(shù)或者日期。字符串值用單引號或“#”標(biāo)記（數(shù)字號）分隔（如“字段1= ‘值1’”或“字段1 =#值1#”）。日期值用#標(biāo)記（數(shù)字號）分隔（如start_date > #7/22/97#）并可包括小時、分鐘和秒以指示時間戳，但不能包括毫秒，否則將出現(xiàn)錯誤。
如果比較操作符為like，可以在字符串值中包含星號 (*) 以查找一次或多次出現(xiàn)的任意字符或子字符串。
*（星號）可以只在條件字符串的結(jié)尾使用，也可以在條件字符串的開頭和結(jié)尾一起使用，如上所示（注：不能將星號作為前導(dǎo)通配符 ('*str') 或嵌入通配符 ('s*r') 使用。這將引發(fā)錯誤）。
查詢“推薦業(yè)務(wù)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 [數(shù)據(jù)庫$A1:D]"objrst.Open sql, objcnn, 1, 3With Worksheets("結(jié)果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標(biāo)題.Cells(1, i + 1) = objrst.Fields(i).NameNextj = 2objrst.MoveFirst '注意：數(shù)據(jù)集在查詢后可能不在第一行，每次查詢前移到第一行是穩(wěn)妥行為'不指定開始行參數(shù)的情況下，Find會從當(dāng)前行開始查詢objrst.Find "推薦業(yè)務(wù)1 like '*和目1*'"Do While Not objrst.EOFFor i = 0 To objrst.Fields.Count - 1 '輸出數(shù)據(jù).Cells(j, i + 1) = objrst.Fields(i)Nextj = j + 1objrst.Find "推薦業(yè)務(wù)1 like '*和目1*'", 1LoopEnd Withobjrst.Closeobjcnn.CloseSet objrst = NothingSet obcnn = NothingApplication.ScreenUpdating = True End Sub6.2 Filter 屬性
用 Filter屬性選擇性地屏蔽 Recordset 對象中的記錄。條件字符串由字段名-操作符-值格式（如“字段1 = '值1'”）子句組成。通過連接單獨(dú)的 AND（如“字段1 = '值1' AND字段2= '值2'”）或 OR（如“字段1 = '值1' OR 字段2= '值2'”）子句可以創(chuàng)建復(fù)合子句。對于條件字符串，請遵循以下規(guī)則：
-
字段名必須是 Recordset 對象中有效的字段名（如果字段名包含空格，必須將字段名括在方括號中）；
-
操作符必須是下列字符串之一：<、>、<=、>=、<>、= 或 LIKE；
-
字符串使用單引號；
-
日期使用磅符號 (#)；
-
數(shù)字可以使用小數(shù)點(diǎn)、美元符號和科學(xué)符號；
-
如果操作符為LIKE，則值可以使用通配符，只允許使用星號 (*) 和百分號 (%) 通配符，可在模式的開頭和結(jié)尾使用通配符，（如 字段 Like '*ab*'），或者只在模式的結(jié)尾使用通配符（如 字段 Like 'Tab*'）。
-
AND 和 OR 在級別上沒有先后之分，可用括號將子句分組。但不能象下例所示那樣先將由 OR 連接的子句分組，然后再用 AND 將該組連接到其他子句：
(字段1=‘值1’ OR字段1=‘值2’) AND字段2=‘值3’，與之相反，可將此過濾構(gòu)造為：
(字段1=‘值1’ AND字段2='值3') OR (字段1='值2' AND字段2='值3')
說明：值 是用于與字段值進(jìn)行比較的值（如 '張三'、#8/24/95#、12.345）。
為實(shí)現(xiàn)2.1節(jié)相同的查詢結(jié)果，可用代碼：
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 [數(shù)據(jù)庫$A1:D]"objrst.Open sql, objcnn, 1, 3With Worksheets("結(jié)果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標(biāo)題.Cells(1, i + 1) = objrst.Fields(i).NameNextobjrst.Filter = "推薦業(yè)務(wù)1 like '%和目1%' and 推薦業(yè)務(wù)2='流量套餐2' and 推薦業(yè)務(wù)3='放心用5'" '查詢篩選If objrst.RecordCount Then '篩選后如果有符合條件的子集，則RecordCount>0.Range("a2").CopyFromRecordset objrst '輸出數(shù)據(jù)End Ifobjrst.Filter = "" '這條語句清空篩選條件End Withobjrst.Closeobjcnn.CloseSet objrst = NothingSet obcnn = NothingApplication.ScreenUpdating = True End Sub如果 Recordset 對象的Find方法無法滿足需求，而你又不想使用Filter，那么，你可以像使用數(shù)組一樣循環(huán) Recordset 對象，使用前面介紹的Instr和Like方法查詢。循環(huán) 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 [數(shù)據(jù)庫$A1:D]"objrst.Open sql, objcnn, 1, 3With Worksheets("結(jié)果集").UsedRange.ClearContentsFor i = 0 To objrst.Fields.Count - 1 '輸出標(biāo)題.Cells(1, i + 1) = objrst.Fields(i).NameNextj = 2Do While Not objrst.EOFIf objrst("推薦業(yè)務(wù)1") Like "*和目1*" And objrst("推薦業(yè)務(wù)2") = "流量套餐2" And objrst("推薦業(yè)務(wù)3") = "放心用5" ThenFor i = 0 To objrst.Fields.Count - 1 '輸出數(shù)據(jù).Cells(j, i + 1) = objrst.Fields(i)Nextj = j + 1End Ifobjrst.MoveNextLoop '================================================================== '或者如下代碼。注意：objrst(i)=objrst.Fields(i)，且字段下標(biāo)是從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 '輸出數(shù)據(jù) ' .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 對象 轉(zhuǎn)成真的數(shù)組以符合使用習(xí)慣，可以使用 GetRows 方法將 Recordset 中的記錄復(fù)制到二維數(shù)組中。第一個下標(biāo)標(biāo)識字段，第二個下標(biāo)標(biāo)識記錄編號，下標(biāo)編號從0開始。GetRows獲得的數(shù)組是倒過來的，需要轉(zhuǎn)置一次才符合使用習(xí)慣，可以實(shí)現(xiàn)自定義轉(zhuǎn)置函數(shù)，可以用工作表函數(shù)Application.WorksheetFunction.Transpose。需要注意的是，工作表轉(zhuǎn)置函數(shù)Transpose只能處理65536行數(shù)據(jù)，且無法處理Null值。Recordset 對象 轉(zhuǎn)成數(shù)組的完整代碼如下：
Sub 轉(zhuǎn)換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 [數(shù)據(jù)庫$A1:D]"arr = objcnn.Execute(sql, , 1).GetRowsarr = transpose(arr) '轉(zhuǎn)置，也可用:Application.WorksheetFunction.TransposeWith Worksheets("結(jié)果集").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) '自定義轉(zhuǎn)置函數(shù)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. 正則表達(dá)式
據(jù)說 正則表達(dá)式（Regular Expression）源于神經(jīng)生物科學(xué)家，想想也是挺神奇的事。正則表達(dá)式絕對是匹配字符串的王者，很復(fù)雜的查詢條件，都能寫在一個模式匹配里面。匹配某類字符串或某種字符串組織規(guī)則時，正則表達(dá)式尤為好用。通過給定一個正則表達(dá)式和另一個字符串，可以實(shí)現(xiàn)兩個目的：
正則表達(dá)式由普通字符和元字符組成。普通字符包括大小寫字母、數(shù)字、下劃線或漢字等，而元字符是事先規(guī)定的符號，具有特殊的含義，了解了元字符的含義，正則表達(dá)式基本上就入門了。下面的元字符是我從網(wǎng)上復(fù)制的， VBA的正則表達(dá)式不支持其中的少量元字符，比如預(yù)查貌似就不支持，使用時加以區(qū)分即可。
| \ | 將下一個字符標(biāo)記符、或一個向后引用、或一個八進(jìn)制轉(zhuǎn)義符。例如，“\n”匹配\n。“\n”匹配換行符。序列“\”匹配“\”而“(”則匹配“(”。即相當(dāng)于多種編程語言中都有的“轉(zhuǎn)義字符”的概念。 |
| ^ | 匹配輸入字行首。如果設(shè)置了 RegExp 對象的 Multiline 屬性，^也匹配“\n”或“\r”之后的位置。 |
| $ | 匹配輸入行尾。如果設(shè)置了 RegExp 對象的 Multiline 屬性，$也匹配“\n”或“\r”之前的位置。 |
| * | 匹配前面的子表達(dá)式任意次。例如，zo*能匹配“z”，也能匹配“zo”以及“zoo”。*等價(jià)于{0,}。 |
| + | 匹配前面的子表達(dá)式一次或多次(大于等于1次）。例如，“zo+”能匹配“zo”以及“zoo”，但不能匹配“z”。+等價(jià)于{1,}。 |
| ? | 匹配前面的子表達(dá)式零次或一次。例如，“do(es)?”可以匹配“do”或“does”。?等價(jià)于{0,1}。 |
| {n} | n是一個非負(fù)整數(shù)。匹配確定的n次。例如，“o{2}”不能匹配“Bob”中的“o”，但是能匹配“food”中的兩個o。 |
| {n,} | n是一個非負(fù)整數(shù)。至少匹配n次。例如，o{2,}不能匹配“Bob”中的o，但能匹配“foooood”中的所有o。o{1,}等價(jià)于o+。o{0,}則等價(jià)于o*。 |
| {n,m} | m和n均為非負(fù)整數(shù)，其中n<=m。最少匹配n次且最多匹配m次。例如，“o{1,3}”將匹配“fooooood”中的前三個o為一組，后三個o為一組。o{0,1}等價(jià)于o?。請注意在逗號和兩個數(shù)之間不能有空格。 |
| ? | 當(dāng)該字符緊跟在任何一個其他限制符(*,+,?，{n}，{n,}，{n,m})后面時，匹配模式是非貪婪的。非貪婪模式盡可能少地匹配所搜索的字符串，而默認(rèn)的貪婪模式則盡可能多地匹配所搜索的字符串。例如，對于字符串“oooo”，“o+”將盡可能多地匹配“o”，得到結(jié)果[“oooo”]，而“o+?”將盡可能少地匹配“o”，得到結(jié)果 [‘o’, ‘o’, ‘o’, ‘o’] |
| . | 匹配除\n和\r之外的任何單個字符。要匹配包括\n和\r在內(nèi)的任何字符，請使用像[\s\S]的模式。 |
| (pattern) | 匹配 pattern 并獲取這一匹配。所獲取的匹配可以從產(chǎn)生的 Matches 集合得到，在 VBScript 中使用 SubMatches 集合，在 JScript 中則使用$0…...$9屬性。要匹配圓括號字符，請使用\(或\)。 |
| (?:pattern) | 非獲取匹配，匹配 pattern 但不獲取匹配結(jié)果，不進(jìn)行存儲供以后使用。這在使用或字符(|)來組合一個模式的各個部分時很有用。例如industr(?:y|ies)就是一個比 industry|industries 更簡略的表達(dá)式。 |
| (?=pattern) | 非獲取匹配，正向肯定預(yù)查，在任何匹配 pattern 的字符串開始處匹配查找字符串，該匹配不需要獲取供以后使用。例如，Windows(?=95|98|NT|2000)能匹配 “Windows2000”中的“Windows”，但不能匹配“Windows3.1”中的“Windows”。預(yù)查不消耗字符，也就是說，在一個匹配發(fā)生后，在最后一次匹配之后立即開始下一次匹配的搜索，而不是從包含預(yù)查的字符之后開始。 |
| (?!pattern) | 非獲取匹配，正向否定預(yù)查，在任何不匹配 pattern 的字符串開始處匹配查找字符串，該匹配不需要獲取供以后使用。例如“Windows(?!95 |
| (?<=pattern) | 非獲取匹配，反向肯定預(yù)查，與正向肯定預(yù)查類似，只是方向相反。例如，“(?<=95 |
| (?<!patte_n) | 非獲取匹配，反向否定預(yù)查，與正向否定預(yù)查類似，只是方向相反。例如“(?<!95 |
| x|y | 匹配x或y。例如，“z |
| [xyz] | 字符集合。匹配所包含的任意一個字符。例如，“[abc]”可以匹配“plain”中的“a”。 |
| [^xyz] | 負(fù)值字符集合。匹配未包含的任意字符。例如，[^abc]可以匹配 “plain” 中的 “plin” 任一字符。 |
| [a-z] | 字符范圍。匹配指定范圍內(nèi)的任意字符。例如，[a-z]可以匹配a到z范圍內(nèi)的任意小寫字母字符。 注：只有連字符在字符組內(nèi)部時,并且出現(xiàn)在兩個字符之間時,才能表示字符的范圍; 如果出字符組的開頭,則只能表示連字符本身. |
| [^a-z] | 負(fù)值字符范圍。匹配任何不在指定范圍內(nèi)的任意字符。例如，[^a-z]可以匹配任何不在a 到z范圍內(nèi)的任意字符。 |
| \b | 匹配一個單詞的邊界，也就是指單詞和空格間的位置（即正則表達(dá)式的“匹配”有兩種概念，一種是匹配字符，一種是匹配位置，這里的\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 | 匹配一個數(shù)字字符。等價(jià)于[0-9]。grep 要加上-P，perl 正則支持 |
| \D | 匹配一個非數(shù)字字符。等價(jià)于[^0-9]。grep要加上-P，perl正則支持 |
| \f | 匹配一個換頁符。等價(jià)于\x0c和\cL。 |
| \n | 匹配一個換行符。等價(jià)于\x0a和\cJ。 |
| \r | 匹配一個回車符。等價(jià)于\x0d和\cM。 |
| \s | 匹配任何不可見字符，包括空格、制表符、換頁符等等。等價(jià)于[ \f\n\r\t\v]。 |
| \S | 匹配任何可見字符。等價(jià)于[^ \f\n\r\t\v]。 |
| \t | 匹配一個制表符。等價(jià)于\x09和\cI。 |
| \v | 匹配一個垂直制表符。等價(jià)于\x0b和\cK。 |
| \w | 匹配包括下劃線的任何單詞字符。類似但不等價(jià)于[A-Za-z0-9_]，這里的 “單詞” 字符使用Unicode字符集。 |
| \W | 匹配任何非單詞字符。等價(jià)于[^A-Za-z0-9_]。 |
| \xn | 匹配n，其中n為十六進(jìn)制轉(zhuǎn)義值。十六進(jìn)制轉(zhuǎn)義值必須為確定的兩個數(shù)字長。例如，\x41匹配A。\x041則等價(jià)于\x04&1。正則表達(dá)式中可以使用ASCII編碼。 |
| \num | 匹配num，其中num是一個正整數(shù)。對所獲取的匹配的引用。例如，(.)\1匹配兩個連續(xù)的相同字符。 |
| \n | 標(biāo)識一個八進(jìn)制轉(zhuǎn)義值或一個向后引用。如果\n之前至少n個獲取的子表達(dá)式，則n為向后引用。否則，如果n為八進(jìn)制數(shù)字(0-7)，則n為一個八進(jìn)制轉(zhuǎn)義值。 |
| \nm | 標(biāo)識一個八進(jìn)制轉(zhuǎn)義值或一個向后引用。如果\nm之前至少有nm個獲得子表達(dá)式，則nm為向后引用。如果\nm之前至少有n個獲取，則n為一個后跟文字m的向后引用。如果前面的條件都不滿足，若n和m均為八進(jìn)制數(shù)字(0-7)，則\nm將匹配八進(jìn)制轉(zhuǎn)義值nm。 |
| \nml | 如果n為八進(jìn)制數(shù)字(0-7)，且m和l均為八進(jìn)制數(shù)字(0-7)，則匹配八進(jìn)制轉(zhuǎn)義值nml。 |
| \un | 匹配n，其中n是一個用四個十六進(jìn)制數(shù)字表示的Unicode字符。例如，\u00A9匹配版權(quán)符號（©）。 |
| \p{P} | 小寫 p 是 property 的意思，表示 Unicode 屬性，用于 Unicode 正表達(dá)式的前綴。中括號內(nèi)的P表示Unicode 字符集七個字符屬性之一：標(biāo)點(diǎn)字符。 其他六個屬性： L：字母； M：標(biāo)記符號（一般不會單獨(dú)出現(xiàn)）； Z：分隔符（比如空格、換行等）； S：符號（比如數(shù)學(xué)符號、貨幣符號等）； N：數(shù)字（比如阿拉伯?dāng)?shù)字、羅馬數(shù)字等）； C：其他字符。 *注：此語法部分語言不支持，例：JavaScript。 |
| \< | 匹配詞（word）的開始（\<）和結(jié)束（\>）。例如正則表達(dá)式\ <the\> 能夠匹配字符串 “for the wise” 中的 “the”，但是不能匹配字符串 “otherwise” 中的 “the”。注意：這個元字符不是所有的軟件都支持的。 |
| \> | |
| ( ) | 將( 和 ) 之間的表達(dá)式定義為“組”（group），并且將匹配這個表達(dá)式的字符保存到一個臨時區(qū)域（一個正則表達(dá)式中最多可以保存9個），它們可以用 \1 到\9的符號來引用。 |
| | | 將兩個匹配條件進(jìn)行邏輯或（Or）運(yùn)算。例如正則表達(dá)式(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.手機(jī)號碼："^1[3|4|5|7|8][0-9]{9}$"；
正則表達(dá)式對象只有 Replace、Test 和 Execute 三個方法，Pattern、Global、Ignorecase和Multiline四個屬性和Matches集合，半個小時就能搞清楚個大概，本論壇（ExcelHome）有很多正則表達(dá)式的教程，這里不再贅敘。
為實(shí)現(xiàn)2.1節(jié)相同的查詢結(jié)果，可用代碼：
Sub 查詢10()Dim arr, brr, i&, j&, k&, reg As ObjectApplication.ScreenUpdating = Falsearr = Worksheets("數(shù)據(jù)庫").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 '存儲原標(biāo)題j = 2Set reg = CreateObject("vbscript.regexp") '創(chuàng)建正則表達(dá)式對象reg.Pattern = "和目1" '匹配模式，正則表達(dá)式的核心所在，多練習(xí)才能掌握For i = 2 To UBound(arr) '查詢條件，用正則表達(dá)式匹配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("結(jié)果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithSet reg = NothingApplication.ScreenUpdating = True End Sub這樣看，貌似正則表達(dá)式也沒什么特殊表現(xiàn)。我們假如要查詢手機(jī)號最后一位數(shù)字是8，倒數(shù)第二、三位數(shù)字是3、6、9中的數(shù)字，用正則表達(dá)式就能體現(xiàn)優(yōu)勢了，只需要reg.Pattern = "[369]{2}8$"，對手機(jī)號碼字段進(jìn)行匹配即可：
Sub 查詢11()Dim arr, brr, i&, j&, k&, reg As ObjectApplication.ScreenUpdating = Falsearr = Worksheets("數(shù)據(jù)庫").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("結(jié)果集").UsedRange.ClearContents.Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brrEnd WithSet reg = NothingApplication.ScreenUpdating = True End Sub更詳細(xì)的正則學(xué)習(xí)帖子：《正則表達(dá)式入門與提高—VBA平臺的正則學(xué)習(xí)參考資料》，如下圖 >> 點(diǎn)擊前往
8.字典和哈希表
上述各種方法既能精確查詢，也能模糊查詢，已經(jīng)足夠使用。如果配合使用數(shù)組，幾十萬行的數(shù)據(jù)查詢，速度也是相當(dāng)快了。但有一個缺點(diǎn)，即每次查詢都需要循環(huán)整個數(shù)據(jù)集，在某些情況下，比如多重循環(huán)，那循環(huán)計(jì)算量相當(dāng)大。這是一個問題。如果有一種方法，給定一個查詢關(guān)鍵字，一步就能定位到需要的數(shù)據(jù)位置，那就能節(jié)約很多時間。理論上是能一步到位的。如著名的MD5算法，碰撞概率是2^256分之一（碰撞就是給定不相同的兩個字符串，散列函數(shù)映射出來的數(shù)字相同），因此只要定義一個足夠大的數(shù)組，用該字符串的映射值作為數(shù)組下標(biāo)位置存放該字符串在數(shù)組中，那么，只要給定查詢關(guān)鍵詞，就能計(jì)算出唯一的數(shù)字，用該數(shù)組作為數(shù)組下標(biāo)，那么總能一步到位找到該位置存儲的數(shù)據(jù)，而無需循環(huán)。
解決上述問題的是一種叫 哈希表 的數(shù)據(jù)結(jié)構(gòu)，這種表中的每個元素都由鍵和數(shù)據(jù)兩部分組成，以數(shù)組的形式存儲。哈希表不使用鍵作為數(shù)組的下標(biāo)（太浪費(fèi)空間了），而是利用某種散列函數(shù)將關(guān)鍵詞（鍵）轉(zhuǎn)換（專業(yè)術(shù)語叫映射）為數(shù)組的下標(biāo)，并用此下標(biāo)的數(shù)組空間存儲數(shù)據(jù)，這樣建立的數(shù)組空間不會占用太多空余空間。詳細(xì)內(nèi)容可自行百度學(xué)習(xí)，也可看看《老兵新傳 Visual Basic核心編程及通用模塊開發(fā)》3.3節(jié)：哈希表，（P53，2012年8月第一版）。
8.1 字典
哈希表的特性是精確查詢，而不適合模糊查詢，因?yàn)椴煌牟樵冴P(guān)鍵詞映射出來的數(shù)字相差甚遠(yuǎn)，根本不可能給出明確的位置指向。據(jù)說字典也是這樣一種散列函數(shù)的產(chǎn)物，假如給定一個完整的手機(jī)號碼（精確查詢），就能 “一步到位” 的找到需要的位置，而無需循環(huán)，而如果只給個手機(jī)尾號（模糊查詢），就要循環(huán)整個字典了。字典是VBA對象，循環(huán)字典遠(yuǎn)不如循環(huán)數(shù)組速度快，模糊查詢還是繼續(xù)用數(shù)組吧。
字典可用于高效地多次精確查詢數(shù)據(jù)（只查詢一次的話，用字典也沒有意義，因?yàn)樾枰h(huán)數(shù)組把數(shù)據(jù)放進(jìn)字典），或用于去重復(fù)。假如我們要從幾十萬個電話號碼中查詢客戶資料，只要把這些客戶資料或資料的位置存儲在字典中，就能建立高效地查詢系統(tǒng)。字典的教程，論壇中有很多精彩的帖子，這里不再贅敘，推薦藍(lán)版一貼：http://club.excelhome.net/thread-868892-1-1.html，本帖只提供字典應(yīng)用的一個簡單代碼：
Sub 查詢12()Dim i&, k, arr, d As Object, reg As Objectarr = Worksheets("數(shù)據(jù)庫").Range("a1").CurrentRegionSet d = CreateObject("scripting.dictionary") '創(chuàng)建字典對象For i = 1 To UBound(arr) '把數(shù)據(jù)裝載到字典。數(shù)據(jù)量巨大時，可只存儲數(shù)據(jù)所在行號d(arr(i, 1)) = arr(i, 2) & "/" & arr(i, 3) & "/" & arr(i, 4)Nextk = Application.InputBox("請輸入查詢的手機(jī)號碼", Type:=1) '手機(jī)號是數(shù)字If k = False Then Exit Sub '輸入框點(diǎn)擊取消時返回FalseSet reg = CreateObject("vbscript.regexp") ' reg.Pattern = "^(?:\+86)?1[34578]\d{9}$"reg.Pattern = "^1[34578]\d{9}$" '判斷手機(jī)號碼是否有誤。非必要！只是復(fù)習(xí)一下正則。If reg.test(k) = False Then MsgBox "手機(jī)號碼輸入有誤": Exit SubIf d.exists(k) ThenMsgBox k & "用戶 套餐：" & String(2, vbNewLine) & d(k)ElseMsgBox "沒有查詢到數(shù)據(jù)"End IfSet d = NothingSet reg = Nothing End Sub8.2 哈希表
剛才已經(jīng)介紹過了，散列函數(shù)，也譯為"哈希"（Hash），就是把任意長度的輸入，通過散列算法，映射成固定長度的輸出。著名的散列算法有MD5、SHA1、CRC32等。字典也應(yīng)該是散列函數(shù)的產(chǎn)物，因字典是商業(yè)產(chǎn)品，需要考慮經(jīng)濟(jì)性（占用更是資源）、易用性、穩(wěn)定性，在速度上可能會有所折扣，在幾十萬行數(shù)據(jù)的情況下已經(jīng)足夠，但如果數(shù)據(jù)量更大時，則會顯得稍微慢一些，于是在處理特殊情況時，有些朋友會利用散列函數(shù)的原理和算法，自定義自己的字典來處理，這樣在速度上更上一層樓。自定義字典的關(guān)鍵是構(gòu)造哈希函數(shù)和解決碰撞問題。散列函數(shù)的算法很復(fù)雜，但那是數(shù)學(xué)家的事，而自定義字典（或哈希表）則是簡單的事，主要是利用數(shù)學(xué)家和計(jì)算機(jī)科學(xué)家的研究結(jié)論解決碰撞問題，往往幾十句代碼就能做出可用的哈希表。
上邊提到的書中有內(nèi)容是介紹哈希表的原理的，可以先看看。論壇有不少自定義的字典帖，例如：http://club.excelhome.net/thread-1372101-1-1.html，利用動態(tài)鏈接庫"ntdll.dll" 中的函數(shù)"RtlComputeCrc32"（即CRC32）作為散列函數(shù)。RtlComputeCrc32返回一個32位的長整數(shù)，碰撞概率約2^32分之一，但是計(jì)算速度比MD5快很多，是一種廉價(jià)而高效的算法，基本上也能滿足運(yùn)用需求。代碼證返回的32位的長整數(shù)跟&H7FFFFFFF按位與，是把返回值的最高位置為0，因?yàn)?amp;H7FFFFFFF=01111111111111111111111111111111，這樣就能保證是正數(shù)了（對VBA來說，Long數(shù)據(jù)類型最高位為1時是負(fù)數(shù)，負(fù)數(shù) mod 哈希表的大小是負(fù)數(shù)，負(fù)數(shù)不便作為數(shù)組的下標(biāo)）。這里不再舉例，感興趣的可以去研究一下，也許哪天用得到呢。
CRC32的算法VBA代碼沒有，但MD5的算法代碼卻很多，這里復(fù)制一份讓大家切身體會一下。代碼源于網(wǎng)絡(luò)，感謝原作者。
（附件）
9.相似度計(jì)算
我們在百度查詢框中輸入一個關(guān)鍵詞，為什么總能找到相關(guān)性很高的結(jié)果呢？這涉及到相似度計(jì)算問題。計(jì)算字符串相似度的算法有歐幾里得距離、海明距離、杰卡德距離、編輯距離、KMP算法等等，商用的漢語相似度算法往往很復(fù)雜，要涉及到字形、讀音等各種因素，這里只簡單說說編輯距離的算法。
編輯距離的算法是首先由俄國科學(xué)家 Levenshtein 提出的，故又叫 Levenshtein距離，指的是兩個字符串之間，由一個轉(zhuǎn)換成另一個所需的最少編輯操作次數(shù)，許可的編輯操作包括將一個字符替換成另一個字符，插入一個字符，刪除一個字符。算法原理在《編程之美》3.3節(jié) 計(jì)算字符串的相似度，（P230，2008年3月第一版）有介紹，網(wǎng)上的資料更多，
例如：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. 其他方法
工作表函數(shù)MATCH， FIND，SEARCH等也可以在 VBA 中使用來查詢，工作表函數(shù)只要使用Application.WorksheetFunction為前綴即可，但這些都是非主流用法，略去不講了。
11. 查詢過程的效率問題
上面的各種技術(shù)只是解決了查詢和匹配問題，還有輸出問題效率問題需要解決。如果查詢數(shù)據(jù)集龐大，比如有百萬行數(shù)據(jù)，就需要注意查詢過程中的效率問題，程序設(shè)計(jì)不好，會嚴(yán)重影響運(yùn)行效率，后果就是體驗(yàn)效果不佳。造成運(yùn)行效率低下的原因除了程序代碼的問題外，還有兩個原因：多余的顯示和多余的查詢。
11.1 多余的顯示
一般創(chuàng)建的查詢系統(tǒng)是在窗體中設(shè)置一個TEXTBOX查詢框，然后運(yùn)用Change事件根據(jù)輸入值自動查詢并顯示符合條件的數(shù)據(jù)子集。通過分析得知，當(dāng)我們輸入的查詢關(guān)鍵詞很少時，比如一個字符時，肯定會匹配絕多部分?jǐn)?shù)據(jù)，但這些數(shù)據(jù)都不是最終想要的結(jié)果，如果我們把這些數(shù)據(jù)都顯示出來，會造成極大地輸出效率問題，因?yàn)橄蛄斜砜丶?#xff08;Listbox、Listview等）添加數(shù)據(jù)并顯示出來，是低效的。同時也是一種浪費(fèi)，因?yàn)檫@么龐大的結(jié)果集沒法看，只能導(dǎo)出到文件另行處理。多余的顯示可以用分頁技術(shù)解決，減輕輸出到顯示的壓力，即每次只顯示一部分結(jié)果，如果確有需要，再逐步顯示剩余的數(shù)據(jù)。
11.1.1 使用 ADO 查詢的分頁技術(shù)。
我們可新建一個窗體，并初始化：
Private Sub UserForm_Initialize()Dim sql$, i&, j&, col&, a()With Sheet2col = .Range("A1").CurrentRegion.Columns.Count '列數(shù)ReDim a(col - 1)For i = 0 To UBound(a)a(i) = .Columns(i + 1).ColumnWidth * 10 '創(chuàng)建Listview列寬數(shù)據(jù)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 [數(shù)據(jù)庫$A1:D] where 1<>1" '只要標(biāo)題，不要數(shù)據(jù)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 = "準(zhǔn)備就緒"模糊查詢.SetFocus End Sub在文本框“模糊查詢”的Change事件中創(chuàng)建查詢語句，根據(jù)用戶輸入內(nèi)容動態(tài)查詢數(shù)據(jù)。
注意，rst是一個公共 Recordset 對象，用來存儲查詢后的結(jié)果集，然后調(diào)用 “下一頁” 子過程顯示第一頁：
Private Sub 模糊查詢_Change()Dim sql$, temp$, i&, j&, s$Set rst = CreateObject("adodb.recordset")temp = 模糊查詢.Textsql = "select * from [數(shù)據(jù)庫$A1:D]"If temp <> "" Then '模糊查詢.Text不為空For i = 0 To rs0.Fields.Count - 1 '逐個字段,從0開始循環(huán)結(jié)果集全部列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 "已顯示所有數(shù)據(jù)": 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 "已顯示所有數(shù)據(jù)": Exit Subrst.Move -(ListView1.ListItems.Count + 10) '每次倒退10條(顯示多少條就倒退多少條)If rst.BOF Then MsgBox "已顯示所有數(shù)據(jù)": 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 對象會記住數(shù)據(jù)移動到哪一行，不需要你去控制。但有時候不適合使用 ADO 技術(shù)，因?yàn)閿?shù)據(jù)比較亂，或者不規(guī)范，這時候就得使用數(shù)組的方式。
11.1.2 使用數(shù)組的分頁技術(shù)
同樣，創(chuàng)建一個窗體并初始化。這里drr是數(shù)據(jù)源數(shù)組，crr是保存查詢結(jié)果的數(shù)組，都是模塊級公共變量，方便不同過程調(diào)用。
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 = "準(zhǔn)備就緒"模糊查詢.SetFocus End Sub在文本框“模糊查詢”的Change事件中創(chuàng)建查詢語句，根據(jù)用戶輸入內(nèi)容動態(tài)查詢數(shù)據(jù)。
注意代碼中的注釋說明。Preserve運(yùn)算效率比較低，其實(shí)可以每次把維數(shù)擴(kuò)展100甚至1000，這樣就能減少Preserve的使用次數(shù)，同時也不會浪費(fèi)多少數(shù)組空間。
當(dāng)然也可以定義一個跟數(shù)據(jù)源數(shù)組一樣大小的數(shù)組來保存查詢結(jié)果，這樣就不需要Preserve和轉(zhuǎn)置，效率更高。也可以定義一個跟數(shù)據(jù)源數(shù)組行數(shù)一樣多的數(shù)組，只保存符合條件的數(shù)據(jù)的行號，這樣查詢結(jié)果的保存會更輕松。待需要輸出時根據(jù)行號可一步到位地找到數(shù)據(jù)行。這個代碼可自行完成。
Private Sub 模糊查詢_Change()Dim txt$, i&If IsEmpty(drr) Then Exit Subtxt = 模糊查詢.TextIf Len(txt) = 0 Then Exit Subcnt = 0 '記錄符合查詢條件的數(shù)據(jù)的條數(shù)pos = 0 '記錄每次輸出之后crr數(shù)組的位置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效率比較低，其實(shí)可以每次把維數(shù)擴(kuò)展100甚至1000， ' 這樣就能減少Preserve的使用次數(shù)，也不會浪費(fèi)多少數(shù)組空間。 ' 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 ' 當(dāng)然也可以定義一個跟數(shù)據(jù)源數(shù)組一樣大小的數(shù)組來保存查詢結(jié)果， ' 這樣就不需要Preserve和轉(zhuǎn)置，效率更高。 ' 也可以定義一個跟數(shù)據(jù)源數(shù)組行數(shù)一樣多的數(shù)組，只保存符合條件的 ' 數(shù)據(jù)的行號，這樣查詢結(jié)果的保存會更輕松。待需要輸出時根據(jù)行號 ' 可一步到位地找到數(shù)據(jù)行。這個代碼可自行完成。crr = transpose(crr)Call 下一頁 End Sub數(shù)組的分頁代碼如下：
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 "已顯示所有數(shù)據(jù)": Exit SubIf pos = 0 Then pos = 1 'Listview中沒有顯示過數(shù)據(jù)的情形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 "已顯示所有數(shù)據(jù)": Exit Subpos = pos - (ListView1.ListItems.Count + 10) '每次倒退10條(顯示多少條就要倒退多少條)If pos <= 0 Then MsgBox "已顯示所有數(shù)據(jù)": 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多余的查詢
查詢的過程不一定需要顯示所有數(shù)據(jù)，有時候也不一定需要查詢所有數(shù)據(jù)。很多時候我們查詢的結(jié)果都是可預(yù)知的很小的數(shù)據(jù)子集，比如查詢某個賬號的資料數(shù)據(jù)，比如某訂單的商品明細(xì)，其結(jié)果集都是很小的，因此，在逐步輸入查詢關(guān)鍵詞的過程中，根本無需查詢整個數(shù)據(jù)庫，因?yàn)闆]有誰會從幾千幾萬行查詢結(jié)果中去找自己想要的數(shù)據(jù)，我們只要查詢滿足條件的100行（或者更少，根據(jù)實(shí)際情況而定）的數(shù)據(jù)就可以退出查詢循環(huán)，等查詢關(guān)鍵詞輸入到足夠多的時候，符合條件的結(jié)果集都不會超過限定的行數(shù)。當(dāng)然，為了保險(xiǎn)起見，每次只查詢少量數(shù)據(jù)，可能會導(dǎo)致數(shù)據(jù)遺漏，還得有一個讓用戶顯示剩余符合條件的結(jié)果的功能。
這種技術(shù)因?yàn)椴皇遣樵冋麄€數(shù)據(jù)源，且不查詢到最后是不知道有多少數(shù)據(jù)符合查詢條件的，結(jié)果集是未知的，我稱之為動態(tài)加載數(shù)據(jù)，我在 http://club.excelhome.net/thread-1424969-1-1.html 的第七節(jié)中已經(jīng)介紹過，這里再復(fù)習(xí)一遍吧。
該方法的核心代碼是：
- lv：istView對象，需要新增Listitem的目標(biāo)對象；
- lngIdx：數(shù)據(jù)數(shù)組的起始查詢位置，動態(tài)加載數(shù)據(jù)；
- lngCount：需要新增滿足查詢條件的Listitem行數(shù)；
- lngRowIndex：記錄arrData數(shù)組當(dāng)前位置的全局變量；
示例：
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’計(jì)數(shù)器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 = "數(shù)據(jù)加載完了" Else Label2 = "滾動鼠標(biāo)可繼續(xù)加載數(shù)據(jù)……" End Sub調(diào)用AddListItems時，只要指定從數(shù)據(jù)源什么位置開始查詢，并指定查詢多少匹配行即行停止查詢即可。在查詢框中可直接調(diào)用：
Private Sub 模糊查詢_Change()ListView1.ListItems.ClearAddListItems ListView1, 2, 20 End Sub要想顯示更多數(shù)據(jù)，可新建一個命令按鈕，直接調(diào)用AddListItems：
Private Sub CommandButton1_Click() '顯示更多AddListItems ListView1, lngRowIndex, 20 End Sub如果想要滾動鼠標(biāo)中鍵和拖動Listview垂直滾動條也能動態(tài)加載數(shù)據(jù)，只要監(jiān)聽到這些事件時，調(diào)用AddListItems即可，非常方便。要監(jiān)聽Listview的鼠標(biāo)事件需要少量 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條數(shù)據(jù)，如有的話，可自行設(shè)置LvmPreWndProc = GetWindowLong(.hwnd, GWL_WNDPROC)SetWindowLong .hwnd, GWL_WNDPROC, AddressOf WndProcEnd WithLabel2 = "準(zhǔn)備就緒"模糊查詢.SetFocus End Sub注意，退出窗體時，需要還原窗體的窗口函數(shù)：
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)SetWindowLong ListView1.hwnd, GWL_WNDPROC, LvmPreWndProc End Sub監(jiān)聽程序如下：
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 '滾動鼠標(biāo)中鍵If wParam = &HFF880000 ThenIf lngRowIndex <= UBound(arrData) Then.AddListItems .ListView1, lngRowIndex, 1End IfEnd IfEnd SelectEnd WithWndProc = CallWindowProc(LvmPreWndProc, hwnd, Msg, wParam, lParam) End Function12. 補(bǔ)充
可以這么說，只要不是對所有數(shù)據(jù)都進(jìn)行處理，基本上都涉及到查詢問題，要通過查詢操作辨識需要處理的數(shù)據(jù)。其實(shí)密碼也是需要查找的，你的論壇密碼不會明文保存在論壇數(shù)據(jù)庫，而會計(jì)算出MD5保存在數(shù)據(jù)庫。那樣，就算別人知道你密碼的MD5值也沒有用，因?yàn)镸D5是不可逆的運(yùn)算，無法根據(jù)MD5倒退出你的密碼明文。看到很多朋友做的登錄系統(tǒng)都保存密碼明文，其實(shí)通過MD5運(yùn)算再保存會安全得多。
有時候文件也需要查詢匹配是否一致。比如 秒傳技術(shù)，本質(zhì)就是MD5算法，網(wǎng)盤或者其他文件服務(wù)器會先計(jì)算你傳輸文件的MD5，然后跟它數(shù)據(jù)庫里面的MD5值比對，如果你的文件的MD5在數(shù)據(jù)庫中存在，你的文件根本不會被傳輸，這就是秒傳。還有，下載軟件也會使用MD5搜索資源，因?yàn)槊總€人保存的文件名可能不同，且比較文件名是不可靠的，同名的文件很大，而通過MD5就能找到確定相同的文件。再分享一個計(jì)算文件MD5的代碼，算法是 API 函數(shù)，供大家參考：
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) = "創(chuàng)建日期".Cells(1, 3) = "修改日期".Cells(1, 4) = "文件類型".Cells(1, 5) = "文件大小".Cells(1, 6) = "MD5 數(shù)值".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 "文件已全部獲取！點(diǎn)『確定』鍵結(jié)束" End Sub計(jì)算文件的MD5值 >> 點(diǎn)擊下載
所有示例源碼 >> 點(diǎn)擊下載
13．總結(jié)
本帖介紹的查詢技術(shù)包括匹配過程和輸出過程。匹配過程最常使用Instr、Like、正則表達(dá)和字典，但是 ADO 方式在多人協(xié)作環(huán)境更常用，因?yàn)槎嗳藚f(xié)作的環(huán)境基本涉及到數(shù)據(jù)庫。Range 對象 的Find方法、自動篩選和高級篩選功能也可以方便的使用，如果不追求效率的話。相似度計(jì)算在某些場合也是可以使用的。熟悉這些方法對于我們的編程能力的提高應(yīng)該會有所裨益。
14. 精彩點(diǎn)評
-
網(wǎng)友1：
- 第一是關(guān)于正則表達(dá)式說明部分，零寬斷言部分，有兩種情況VBA 的正則表達(dá)式根本不支持，所以應(yīng)該從剔除掉。
- 第二點(diǎn)是 ADO 部分，如果數(shù)據(jù)源是Excel 表的話，數(shù)據(jù)類型猜測的坑是不可避免的，修改注冊表也是飲鴆止渴的解決方案，Excel 模糊數(shù)據(jù)類型就是SQL 的大忌。還有就是由于Excel 表沒有索引的概念所有，都是全表掃描select，那么用于分頁的高效語句執(zhí)行在Excel 里面和數(shù)據(jù)庫是不同的，本身并沒有意義。
-
作者回復(fù)：
- 那個表格是我復(fù)制的（打字太慢了），正反預(yù)查在VBA中應(yīng)該也不支持，我檢查過，還有極少量元字符也是不支持的，但最重要的那些元字符沒問題，不會影響正常使用，我就沒有剔除，只提示某些元字符對于VBA無效。每種計(jì)算機(jī)語言的正則表達(dá)式的語法稍有區(qū)別，但好在元字符基本是一致的，學(xué)會了就能通用了，就跟SQL語句和ADO，基本上到處可用。
- ADO在EXCEL中判斷不規(guī)范數(shù)據(jù)的表格的類型偶有失誤，所以我也說明了在數(shù)據(jù)規(guī)范的表格中的適用性。但數(shù)據(jù)查詢與匹配，包括但不限于EXCEL，還可以涉及到數(shù)據(jù)庫的查詢，所以也是可以作為一個知識點(diǎn)的，使用者只要根據(jù)情況靈活使用即可。
-
網(wǎng)友2：
- 建議每個小結(jié)都附帶一個單獨(dú)的源代碼表格。最好程序里沒有中文，不然我們的英文office打不開；
-
作者回復(fù)：
- 自己把代碼復(fù)制到文件中，親身實(shí)踐一下，才能加強(qiáng)理解。
總結(jié)
以上是生活随笔為你收集整理的VBA各种查询方法介绍和应用举例的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。
- 上一篇： 通过网络地址进行真机调试
- 下一篇： python-小数点保留位数问题