Excel - 无法找到范围,错误91

时间:2016-12-19 03:42:22

标签: excel vba excel-vba email

我尝试从查找表(不同的表格)中查找单元格中输入的电子邮件。我尝试从Cell K中查找名称并在R单元格中查找电子邮件。 我查找来自不同表格的电子邮件,称为电子邮件。 enter image description here

enter image description here

这是我的查找表。但是当我尝试使用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真的很陌生。这是我的调试结果

enter image description here

2 个答案:

答案 0 :(得分:1)

继续使用每个用户使用test('throws works with functions that return promises', async t => { await t.throws(returnsPromise(), 'foo'); }); 的代码方法,我添加了一个循环,该循环从第一行开始,其中包含列K中的数据,直到最后一行包含数据。每个单元格在其他“电子邮件”表单中检查其内部所有用户的电子邮件,并将合并的电子邮件Find放在同一行的列K中。

<强>代码

String

我得到的结果的屏幕截图:

enter image description here

答案 1 :(得分:0)

主要根据你的截图,你可能会遇到这样的事情:

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