大家好,今日继续讲解VBA数据库解决方案,今日讲解第40讲:利用ADO实现同一文件的多个工作表精确查询.其实这讲的内容利用我之前讲解的知识点也可以自己完成.这里只是拿出来让大家再熟悉一下EXCEL的ADO连接,及RS多次打开记录集后的查询.

实例:在我的文件.xlsm中有两页"两表查询数据"和"查询数据"，一些基础的数据在这两页文件中：如下截图：

同时我在某页工作表中存在如下数据，要在上述的两个工作表中查出对应的数据资料放在后面:

这个实例也是在工作中经常遇到的，如果扩展使用会更多。

下面看我给出代码：

Sub mynzexcels_40()

'第40讲，利用ADO,实现同一文件的确认查询

Dim cnADO, rsADO As Object

Dim strPath, strTable, strSQL As String

Dim SH As Worksheet

Set cnADO = CreateObject("ADODB.Connection")

'建立连接

strPath = ThisWorkbook.FullName

cnADO.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 8.0;hdr=no;imex=1';data source=" & strPath

i = 2

Do While Cells(i, 1) <> ""

WW = Cells(i, 1)

If InStr(WW, ":") > 0 Then WW = Left(WW, InStr(WW, ":") - 1)

For Each SH In Worksheets

If SH.Name = "两表查询数据" Or SH.Name = "查询数据" Then

strTable = "[" & SH.Name & "$]"

strSQL = "select F2,F3,F4,F5 from " & strTable & " where F1='" & WW & "'"

Set rsADO = New ADODB.Recordset

rsADO.Open strSQL, cnADO, 1, 3

If rsADO.EOF Then GoTo 200

If rsADO.RecordCount > 0 Then

Cells(i, 2).CopyFromRecordset cnADO.Execute(strSQL)

GoTo 100

End If

End If

200:

Next

100:

rsADO.Close

i = i + 1

Loop

cnADO.Close

Set cnADO = Nothing

Set rsADO = Nothing

End Sub

代码截图：

代码讲解：

1 WW = Cells(i, 1)

If InStr(WW, ":") > 0 Then WW = Left(WW, InStr(WW, ":") - 1)

此处我做了一个实例，就是如果在需要查找的数据中含有"："那么要取冒号之前的数据。这是非常实用的一个实例，大家要记住上面的代码。

2 For Each SH In Worksheets 这里使用了一个FOR EACH循环，遍历工作表。

3 If SH.Name = "两表查询数据" Or SH.Name = "查询数据" Then 由于我事先知道我要在两页工作表中查询，所以我精确的控制了两页的工作表名称

4 If rsADO.RecordCount > 0 Then

Cells(i, 2).CopyFromRecordset cnADO.Execute(strSQL)

GoTo 100

End If

上述代码作用：当存在这样的记录，即记录数大于0那么提取数据。

代码的运行：

备注：我写这讲的目的原想是能提高一下在很多的工作表中查询时能提高程序的运行速度，但我在几十个工作表中测试时发现运行的速度反而不如FIND的速度快，这里只是提供给大家一个方法吧。

今日内容回向：

1 如何实现利用ADO在多表中查询？

2 如果用FIND来编写上述代码该如何写呢？