0

我目前正在寻找以下解决方案的替代方案，但使用 ADO 功能以便不打开源工作簿。我想这会减少处理时间吗？

你的意见..

谢谢

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
4

2 回答 2

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
于 2013-01-15T12:34:13.650 回答
0

你错过了这一行：

Set rs = CreateObject("ADODB.Recordset")

出于某种原因，没有它，Win XP 将无法运行。它应该放在con.Open conStr.

于 2013-01-22T19:08:47.577 回答