Извлечение данных из более чем миллиона записей

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 

Это работает (kindof), но это занимает очень много времени и случайно падает. Любые идеи, как улучшить это?

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

Вы можете делать то, что вы описали, но я думаю, что гораздо эффективнее сделать это в самом доступе. Просто создайте таблицу с вашими именами и сделайте Inner Join в таблицу, в которой вы хотите найти 2 поля. Должно занять меньше минуты и, возможно, менее 30 секунд.