Excel – 找不到范围，错误91

我尝试从查找表（不同的工作表）的单元格中的名称input查找电子邮件。 我尝试从单元格K中查找名称，并在R单元格中输出电子邮件。 我查找来自不同表单的电子邮件。

这是我的查询表。 但是，当我试图find使用查找，我得到错误91是对象variables或块未设置可能meand它无法从查找表中find范围。 这是我的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真的很陌生。 这是我的debugging结果

Answer 1

继续使用Find per user的代码方法，我添加了一个循环，从第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 (ie 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 (ie 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 (ie 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