我們要完成：

要查詢並彙總當前工作簿的所有班級工作表中的數學成績在100分以上的所有學生記錄

我們要用到:

1.VBA 中的ADO 和SQL;

2.VBA中的迴圈語句;

第一步:引用ADO物件庫。

需要引用的專案如下（如果你的機器裡面是另外的版本，那麼就引用該版本）

Microsoft ADO Ext2.8 for DDL and Security

Microsoft Active Data Objects(Multi-dimensional) 2.8 Library

Microsoft Active Data Objects Recordset 2.8 Library

Microsoft Active Data Objects 2.8 Library

Microsoft Active Jet and Replication Objects 2.8 Library

引用的方法是:在Excel VBA 編輯器視窗中,單擊【工具】選單中的【引用】命令，開啟【引用-VBAProject】對話方塊,勾選相應的專案即可。

第二步:把下面的程式碼寫入“模組”中

Public Sub Search()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim myWorkName As String, n As Integer, i As Integer, sql As String

Worksheets("彙總").Cells.Clear            '清除"彙總"工作表中的所有資料
'建立與當前工作簿的連線
Set cnn = New ADODB.Connection
With cnn
    .Provider = "microsoft.jet.oledb.4.0"
    .ConnectionString = "Extended Properties=Excel 8.0;" & "Data Source=" & ThisWorkbook.FullName
    .Open
End With

'複製標題
Worksheets(2).Range("a1:iv1").Copy Destination:=Worksheets("彙總").Range("a1")

'查詢各個班級工作表

For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "彙總" Then        '迴圈查詢各個班級工作表

myWorkName = Worksheets(i).Name           '獲取班級工作表的名稱

'設定SQL 語句
sql = "select*from[" & myWorkName & "$] where 數學>100"

'開始查詢各個班級中符合條件的學生記錄

Set rs = New ADODB.Recordset

rs.Open sql, cnn, adOpenKeyset, adLockOptimistic

'獲取"彙總"工作表的最後一行

n = Worksheets("彙總").Range("a65536").End(xlUp).Row

'將查詢到的 學生記錄複製到"彙總"工作表中

Worksheets("彙總").Range("a" & n + 1).CopyFromRecordset rs

End If

Next i
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing

End Sub

第三步：執行巨集

點選【工具】選單下面的【巨集】中的巨集名中選擇Search，然後點選執行，就能得到我們前面所說的結果了：查詢並彙總當前工作簿的所有班級工作表中的數學成績在100分以上的所有學生記錄