Excel - Не удается найти диапазон, ошибка 91

Question

Я попытался найти электронные письма от имени ввода в ячейке из таблицы поиска (разные листы). Я пытаюсь найти имена из Cell K и получать сообщения электронной почты в R-ячейках. Я просматриваю письма из разных листов, называемых электронной почтой.

Это моя таблица поиска. Но когда я пытаюсь найти с помощью Find, я получаю ошибку 91, которая является переменной объекта или с не установленным блоком, который, вероятно, может быть не найден и не может найти диапазон из таблицы поиска. Это мои коды VBA для разделенных имен и поиска. Я хотел бы вывести ';' в конце каждого имени, чтобы я мог просто отправлять электронные письма с электронной почтой для всех из них в ячейках.

Public Sub getEmails() 
    Dim toNames As Range 
    Set toNames = Range("K11") ' names input by user 

    Dim names As Range 
    Set names = Sheets("Email").Range("B2:C23") ' names range from lookup table from different worksheet 

    Dim splitNames 
    splitNames = Split(toNames, ",") 


    Dim selectedEmails As String 
    Dim findRange As Range 

For i = 0 To UBound(splitNames) 
    ' find the range matching the name 
    Set findRange = names.Find(What:=splitNames(i), LookIn:=xlFormulas, _ 
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False) 

    ' if match found, get the email and store to selected emails variable 
    If Not findRange Is Nothing Then 
    selectedEmails = selectedEmails & Sheets("Email").Range("C" & findRange.Row) & ";" 
    End If 

    Next i 

    'output emails 
    Range("R11") = selectedEmails 
End Sub 

Пожалуйста, помогите, я действительно новичок в этом VBA. Это мой отладки результат

Answer 1

Продолжая с кодом подхода с использованием Find для каждого пользователя, я добавил цикл, который начинается с первой строки с данными в столбце K, до последней строки с данными. В ячейке он проверяет всех пользователей внутри своих электронных писем на другом листе «Электронная почта» и помещает объединенные электронные письма String в столбце K той же строки.

Код

Option Explicit 

Public Sub getEmails() 

Dim names As Range, findRange As Range 
Dim splitNames 
Dim selectedEmails As String, i As Long, lRow As Long 

Set names = Sheets("Email").Range("B2:C23") ' names range from lookup table from different worksheet 

' modify "Sheet1" to your sheet's name 
With Sheets("Sheet1") 
    ' loop column K untill last row with data (staring from row 2 >> modify where you data starts) 
    For lRow = 2 To .Cells(.Rows.Count, "K").End(xlUp).Row 
     ' fill array directly from cell 
     splitNames = Split(.Range("K" & lRow), ",") 

     For i = 0 To UBound(splitNames) 
      ' find the range matching the name 
      Set findRange = names.Find(What:=Trim(splitNames(i)), LookIn:=xlFormulas, _ 
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False) 

      ' if match found, get the email and store to selected emails variable 
      If Not findRange Is Nothing Then 
       If selectedEmails = "" Then ' first email of this row 
        selectedEmails = findRange.Offset(0, 1).Value 
       Else ' add a ";" to separate email addresses 
        selectedEmails = selectedEmails & ";" & findRange.Offset(0, 1).Value 
       End If 

      End If 
     Next i 

     .Range("R" & lRow) = selectedEmails 
     ' clrear all variables and arrays for next cycle 
     Erase splitNames 
     selectedEmails = "" 
    Next lRow 

End With 

End Sub 

снимок экрана результата я получил:

Answer 2

в основном в соответствии с вашими скриншотами, вы можете быть после того, как что-то вроде этого:

Option Explicit 

Public Sub main() 
    Dim cell As Range 

    With Sheets("Names") '<--| change it to actual name of your sheet with "names" 
     For Each cell In .Range("K2", .Cells(.Rows.count, "K").End(xlUp)) '<--| loop through its column K cells from row 2 down to last not empty one 
      WriteEmails cell.Value, cell.Offset(, 7) '<--| call 'WriteEmails()' passing current cell content (i.e. names) and cell to write corresponding emails to 
     Next cell 
    End With 
End Sub 


Sub WriteEmails(names As String, targetRng As Range) 
    Dim cell As Range 
    Dim selectedEmails As String 

    With Sheets("Email") '<--| reference your LookUp sheet 
     With .Range("C1", .Cells(.Rows.count, 2).End(xlUp)) '<--| reference its columns B and C from row 1 (headers) down to column B last not empty row 
      .AutoFilter field:=1, Criteria1:=Split(names, vbLf), Operator:=xlFilterValues '<--| filter it on its 1st column (i.e. column B) with passed 'names' split by 'vblf' 
      If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell filtered other than headers 
       For Each cell In .Resize(.Rows.count - 1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible) '<--|loop through filtered cells in 2nd column (i.e. column "C") 
        selectedEmails = selectedEmails & cell.Value & vbLf '<--| build your emails string, delimiting them by 'vbLf' 
       Next cell 
       targetRng.Value = Left(selectedEmails, Len(selectedEmails) - 1) '<--| write emails string in passed range 
      End If 
     End With 
     .AutoFilterMode = False 
    End With 
End Sub