从超过一百万条记录中提取数据

Question

我有一个Excel文件，我已经建立了与Access数据库的连接。在Excel文件中，列a中有一个名称列表，我希望在Access数据库中搜索这些名称，并从该数据库返回两个字段。我需要为大约200-300个名字做这个。

下面是我的代码:

N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
For i = 2 To N
    Dim rstTable As ADODB.Recordset
    Set rstTable = New ADODB.Recordset
    lookup = Range("A" & i).Value

    strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2]= """ & lookup & """;"
    'Store query output
    rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
    'Paste results to Transactions sheet
    Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable
    'Close the record set & connection
    rstTable.Close
    objConnection.Close
Next i

这工作(有点)，但它需要非常长的时间和随机崩溃。有什么改进的办法吗?

Answer 1

确保在查找字段上有一个键将会有所帮助。我建议制作工作簿的副本，并从Access或MS Query测试外部数据，看看是否会在VBA上获得性能增益。

当使用MS Query或Access中的数据时，可以修改连接属性中的命令文本并使用?在where子句中指定工作表中的参数(这样您就不会失去该功能)。

Answer 2

我修改了SQL语句。将Where [Field2] = "xxx"替换为Where [Field2] IN ("xxx", "yyy", "zzz")

N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
For i = 2 To N
    lookup = lookup & "'" & Range("A" & i).Value & "', "
Next i
lookup = left(lookup, len(lookup) - 2)
Dim rstTable As ADODB.Recordset
Set rstTable = New ADODB.Recordset
strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
'Store query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
'Paste results to Transactions sheet
Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable
'Close the record set & connection
rstTable.Close
objConnection.Close

Answer 3

您在第一次迭代之后关闭了连接，因此您的下一个迭代—没有打开连接的代码—将失败。所以你应该把objConnection.Close移出循环。

但是，即使这样，一次又一次地执行相同类型的查询，只是使用不同的参数，可以一次完成，使用IN (...)语法:

' Declare all your variables
Dim N As Long
Dim strDB As String
Dim objConnection As ADODB.Connection
Dim rstTable As ADODB.Recordset
Dim strSQL As String
N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
' collect the values in comma-separated string
lookup = ""
For i = 2 To N
    lookup = lookup & ",""" & Range("A" & i).Value & """"
Next i
' Chop off the first comma
lookup = Mid(lookup, 2)
' Perform a single query, but also select the Field2 value
Set rstTable = New ADODB.Recordset
strSQL = "SELECT Field2, NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
' query output 
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
' Retrieve values 
While Not rstTable.EOF
    lookup = rstTable.Fields(0).Value
    ' Locate in which row to put the result
    For i = 2 To N
        If lookup = Range("A" & i).Value Then
            Range("B" & i).Value = rstTable.Fields(1).Value
            Range("C" & i).Value = rstTable.Fields(2).Value
        End If
    Next i
    rstTable.MoveNext
Loop    
' Close the record set & connection
rstTable.Close
objConnection.Close

Answer 4

你可以做你所描述的，但我认为它是更有效地做到这一点在Access本身。只需用您的名字创建一个表，并对要查找2个字段的表进行内连接。