Excel - эффективный способ поиска данных по листам

Question

В настоящее время у меня есть таблица с двумя рабочими листами. Первый лист - это список имен и адресов, второй - список с именами и адресами и адресами электронной почты (лист называется «EmailList»)

Я пытаюсь добавить новый столбец на первый рабочий лист, который покажет адрес электронной почты, если адрес электронной почты находится во втором листе, сопоставляя имя, фамилию, номер дома и адрес улицы. Еще лучше было бы показать список на новом листе с целыми строками, которые совпадают.

Я получил письмо с указанием использования:

=INDEX(EmailList!P:P, MATCH(A9&B9&C9&E9, EmailList!A:A&EmailList!B:B&EmailList!C:C&EmailList!E:E, 0)) 

Однако это Soooooo медленно. Первый лист имеет 1000 рядов, второй лист 1500.

Как я могу легко выбрать строки из листа EmailList, где совпадают столбцы Firstname, Lastname, Number, Street name в обоих листах?

Answer 1

Замечания от pnuts и Parfait являются отличными предложениями и заслуживают рассмотрения.

Мне просто интересно, правильна ли ваша структурная логика. Из того, что вы пишете в своих вопросах, а не находите адрес электронной почты для Sheet1, разве вы фактически не удаляете из Sheet2 никаких адресов, которых нет в Sheet1? Если это так, то решение VBA будет довольно коротким и простым. Если вы создали строковый ключ из ваших имен, номера дома, ячеек адресов, вы можете заполнить Collection и просто просмотреть этот ключ в каждой записи Sheet2. Некоторый скелетный код для вас будет выглядеть следующим образом:

Option Explicit 

Sub RunMe() 
    Dim data As Variant 
    Dim r As Long, c As Long, i As Long 
    Dim key As String 
    Dim addrs As Collection 
    Dim emails As Collection 
    Dim hit As Boolean 
    Dim vRow As Variant 
    Dim output As Variant 

    'Read addresses from Sheet1 into collection 
    data = Sheet1.UsedRange.Value2 
    Set addrs = New Collection 
    For r = 1 To UBound(data, 1) 
     key = BuildKey(data, r) 
     addrs.Add True, key 
    Next 

    'Interrogate email list 
    data = Sheet2.UsedRange.Value2 
    Set emails = New Collection 
    On Error Resume Next 
    For r = 1 To UBound(data, 1) 
     key = BuildKey(data, r) 
     hit = False 
     hit = addrs(key) 
     If hit Then emails.Add r 
    Next 
    On Error GoTo 0 

    'Write your results to the new sheet 
    ReDim output(1 To emails.Count, 1 To 5) 
    i = 1 
    For Each vRow In emails 
     For c = 1 To 5 
      output(i, c) = data(vRow, c) 
     Next 
     i = i + 1 
    Next 
    Sheet3.Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output 

End Sub 
Private Function BuildKey(data As Variant, r As Long) As String 
    Dim c As Long 

    For c = 1 To 4 
     BuildKey = BuildKey & CStr(data(r, c)) & "|" 
    Next 
End Function 

Answer 2

Как уже упоминалось, рассмотрим SQL, если используете Excel для ПК. Excel может подключаться к Jet/ACE SQL Engine (файлы Windows .Dll) для запуска запросов на листах, как если бы они были таблицами базы данных. И да, вы можете запросить самую рабочую книгу, в которой вы запускаете макрос, так как вы будете использовать экземпляр последнего сохраненного файла только для чтения.

В частности, запрос ниже запускает INNER JOIN между двумя листами, MainList и адресов электронной на самых столбцов, указанных с выходом на существующий лист, Результаты:

Sub RunSQL()  
    Dim conn As Object, rst As Object 
    Dim strConnection As String, strSQL As String 
    Dim i As Integer 

    Set conn = CreateObject("ADODB.Connection") 
    Set rst = CreateObject("ADODB.Recordset") 

    ' CONNECTION STRINGS (DRIVER VERSION COMMENTED OUT) 
' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ 
'      & "DBQ=C:\Path\To\Workbook.xlsm;" 
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _ 
         & "Data Source='C:\Path\To\Workbook.xlsm';" _ 
         & "Extended Properties=""Excel 12.0;HDR=YES;"";" 

    strSQL = " SELECT t1.*, t2.[EmailAddress]" _ 
       & " FROM [MainList$] t1" _ 
       & " INNER JOIN [EmailList$] t2" _ 
       & " ON t1.FirstName = t2.FirstName" _ 
       & " AND t1.LastName = t2.LastName" _ 
       & " AND t1.HouseNumber = t2.HouseNumber" _ 
       & " AND t1.StreeAddress = t2.StreetAddress;"    
    ' OPEN CONNECTION 
    conn.Open strConnection 
    rst.Open strSQL, conn 

    ' COLUMN HEADERS 
    For i = 1 To rst.Fields.Count - 1 
     Worksheets("Results").Cells(1, i) = rst.Fields(i).Name 
    Next i   
    ' DATA ROWS 
    Worksheets("Results").Range("A2").CopyFromRecordset rst 

    rst.Close: conn.Close  
End Sub 

Answer 3

Я знаю, что это сайт dev, но если вы хотите, чтобы это было очень просто, без какого-либо кода, вы можете использовать PowerPivot, который является бесплатным AddIn.

Вы можете получить AddIn отсюда.

https://support.office.com/en-us/article/Power-Pivot-Add-in-a9c2c6e2-cc49-4976-a7d7-40896795d045

Опять же, это просто еще один вариант для вас. Мне нравится предложение Парфеи! Очень элегантный, сэр!