---

前言

查询（或匹配）是程序设计中最重要的功能之一，只有用好查询功能，才能从纷繁复杂的数据中找到符合要求的数据子集，提高工作效率。查询分为模糊查询和精确查询，只匹配一个字符串中的部分字符串就是模糊查询，完全一致则是精确批量，例如字符串“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 pattern

Like运算符跟其他比较运算符的区别是模式匹配，其pattern参数可以用如下字符：

pattern 中的字符	符合 string 中的
?	任何单一字符。
*	零个或多个字符。
#	任何一个数字 (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 Sub

6.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 Function

7. 正则表达式

据说 正则表达式（Regular Expression）源于神经生物科学家，想想也是挺神奇的事。正则表达式绝对是匹配字符串的王者，很复杂的查询条件，都能写在一个模式匹配里面。匹配某类字符串或某种字符串组织规则时，正则表达式尤为好用。通过给定一个正则表达式和另一个字符串，可以实现两个目的：

1. 给定的字符串是否符合正则表达式的模式串(pattern)，符合就叫匹配，不符合就不匹配；
2. 通过正则表达式，可以从字符串中获取、修改和删除特定部分的字符串、增加特定字符串。
   正则表达式由普通字符和元字符组成。普通字符包括大小写字母、数字、下划线或汉字等，而元字符是事先规定的符号，具有特殊的含义，了解了元字符的含义，正则表达式基本上就入门了。下面的元字符是我从网上复制的， 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匹配版权符号（&copy;）。
\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 Sub

8.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 Function

10. 其他方法

工作表函数MATCH， FIND，SEARCH等也可以在 VBA 中使用来查询，工作表函数只要使用Application.WorksheetFunction为前缀即可，但这些都是非主流用法，略去不讲了。

11. 查询过程的效率问题

上面的各种技术只是解决了查询和匹配问题，还有输出问题效率问题需要解决。如果查询数据集庞大，比如有百万行数据，就需要注意查询过程中的效率问题，程序设计不好，会严重影响运行效率，后果就是体验效果不佳。造成运行效率低下的原因除了程序代码的问题外，还有两个原因：多余的显示和多余的查询。

11.1 多余的显示

一般创建的查询系统是在窗体中设置一个TEXTBOX查询框，然后运用Change事件根据输入值自动查询并显示符合条件的数据子集。通过分析得知，当我们输入的查询关键词很少时，比如一个字符时，肯定会匹配绝多部分数据，但这些数据都不是最终想要的结果，如果我们把这些数据都显示出来，会造成极大地输出效率问题，因为向列表控件（Listbox、Listview等）添加数据并显示出来，是低效的。同时也是一种浪费，因为这么庞大的结果集没法看，只能导出到文件另行处理。多余的显示可以用分页技术解决，减轻输出到显示的压力，即每次只显示一部分结果，如果确有需要，再逐步显示剩余的数据。

11.1.1 使用 ADO 查询的分页技术。

1. 我们可新建一个窗体，并初始化：

   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
   

   
   

2. 在文本框“模糊查询”的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
   

3. 分页代码包括显示上一页和下一页

   算法代码如下

   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 使用数组的分页技术

1. 同样，创建一个窗体并初始化。这里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
   

   
   

2. 在文本框“模糊查询”的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
   

   
   

3. 数组的分页代码如下：

   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 Sub
   

11.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 Function

12. 补充

可以这么说，只要不是对所有数据都进行处理，基本上都涉及到查询问题，要通过查询操作辨识需要处理的数据。其实密码也是需要查找的，你的论坛密码不会明文保存在论坛数据库，而会计算出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打不开；

• 作者回复：

  • 自己把代码复制到文件中，亲身实践一下，才能加强理解。