ADOfunction..复制，过滤，从封闭的工作簿粘贴到活动wrokbook

我目前正在寻找下面的解决scheme的替代scheme，但使用ADOfunction，以便打开源工作簿。 我想象这会减less处理时间？

你的想法..

谢谢

Sub CopyFilteredValuesToActiveWorkbook() Dim wbSource As Workbook, wbDest As Workbook Dim wsSource As Worksheet, wsDest As Worksheet Dim rngSource As Range, rngDest As Range Set wbSource = Workbooks.Open("\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx", , True) 'Readonly = True Set wsSource = wbSource.Worksheets("LogData") wsSource.Range("$A$1:$H$3").AutoFilter Field:=3, Criteria1:="Opera" Set rngSource = wsSource.Range("A:Z") Set wbDest = ThisWorkbook Set wsDest = wbDest.Worksheets("MLF") Set rngDest = wsDest.Range("A:Z") rngDest.Value = rngSource.Value 'Copies values over only, if you need formatting etc we'll need to use something else wbSource.Close (False) 'Close without saving changes End Sub 

Answer 1

你错过了这一行：

 Set rs = CreateObject("ADODB.Recordset") 

由于某些原因，Win XP将无法运行。 应该在con.Open conStr后con.Open conStr

Answer 2

您可以使用对Active X Data Objects 6.0的引用来使用SQL查询

 Const adOpenStatic = 3 Const adLockOptimistic = 3 Const adCmdText = &H1 Public Sub GetValues (path as String, destination as Range) Dim conStr as String, strSQL as string Dim con as new ADODB.Connection, rs as new ADODB.Recordset conStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & path & "';" & _ "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";" strSQL = "SELECT * FROM [LogData$] WHERE [CriteriaColumn] = 'Opera'" con.Open conStr rs.open strSQL, con, adOpenStatic, adLockOptimistic, adCmdText destination.CopyFromRecordset rs rs.close con.close End Sub 

其中CriteriaColumn是用作过滤条件的列的标题

你可以调用子程序如下：

 Dim path as string, rngDest as Range path = "\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx" 'The Upper left cell of the range that will receive the data: Set rngDest = ThisWorkbook.Worksheets("MLF").Range("A1") GetValues path, rngDest