DB_Data表：
Data2表：
| Option Explicit Sub ADO_Self_Excel() Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim sSQL As String Dim sPath As String Dim MyConn Dim sFilter As String sPath = ActiveWorkbook.FullName '定義篩選和提取姓名的SQL語(yǔ)句. '在ADO中使用%作為通配符而不是* sFilter = UCase(Sheets("Data2").Range("H1").Value) & "%" '在SQL中可以像表一樣看待工作表名稱 '為此,將后綴$放置在名稱的末尾并加上方括號(hào) sSQL = "SELECT * FROM [DB_Data$]" 'DB_Data是源工作表 sSQL = sSQL & " WHERE LastName Like '" & sFilter & "'" '建立對(duì)相同文件的連接 '當(dāng)連接到Excel而不是數(shù)據(jù)庫(kù)時(shí),需要定義擴(kuò)展的屬性為Excel 8.0 (第1個(gè)使用ADO的Excel版本) MyConn = sPath Set cnn = New ADODB.Connection With cnn .Provider = "Microsoft.Jet.OLEDB.4.0" .Properties("Extended Properties").Value = "Excel 8.0" .Open MyConn End With '定義基于SQL語(yǔ)句的記錄集 Set rst = New ADODB.Recordset rst.CursorLocation = adUseServer rst.Open Source:=sSQL, _ ActiveConnection:=cnn, _ CursorType:=adOpenForwardOnly, _ LockType:=adLockOptimistic, _ Options:=adCmdText Application.ScreenUpdating = False '刪除目標(biāo)工作表中已存在的數(shù)據(jù) '然后以單元格A2開(kāi)始填充最新篩選的結(jié)果 '完成后,清除引用以避免內(nèi)存泄漏 With Sheets("Data2") 'Data2是目標(biāo)工作表 .Range("A1").CurrentRegion.Offset(1, 0).Clear .Range("A2").CopyFromRecordset rst End With rst.Close cnn.Close Application.ScreenUpdating = True End Sub |
下面的代碼使用相應(yīng)工作表Data2中的Worksheet_Change事件。這樣，當(dāng)單元格H1發(fā)生變化時(shí)，ADO_Self_Excel將使用H1中的內(nèi)容創(chuàng)建篩選。如果H1為空，那么返回所有的記錄。
| Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Intersect(Range("H1"), Target) Is Nothing Then Exit Sub Call ADO_Self_Excel End Sub |
聯(lián)系客服
