我尝试从查找表(不同的表格)中查找单元格中输入的电子邮件。我尝试从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真的很陌生。这是我的调试结果
答案 0 :(得分:1)
继续使用每个用户使用test('throws works with functions that return promises', async t => {
await t.throws(returnsPromise(), 'foo');
});
的代码方法,我添加了一个循环,该循环从第一行开始,其中包含列K中的数据,直到最后一行包含数据。每个单元格在其他“电子邮件”表单中检查其内部所有用户的电子邮件,并将合并的电子邮件Find
放在同一行的列K中。
<强>代码强>
String
我得到的结果的屏幕截图:
答案 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