Excel 宏，它从一列中查找每个值并返回带有“quot；”的电子邮件地址&引用；分离器

有人用公式帮我解决了这个问题。不幸的是，我需要一个适用于Excel 2016的解决方案，而VBA似乎是最佳/唯一的途径

非常感谢您的帮助

图例：（在同一工作簿中的多个工作表中）

每列都有一个标题。
第3张A栏：姓名列表
第3页H栏：电子邮件地址列表
Sheet1的M列：包含以下向下拖动的公式，该公式生成可变数量的数据行：

=IFERROR（索引（$A$2:$A$42，匹配（0，如果（$1“=$L$2:$L$42，计数如果（$O$1:$O1，$A$2:$A$42），”），0）），）

在Sheet1的M列中，我有一个

Index/Match

公式，其中填充了一个人名列表。（如上所述，出现的姓名数量不断变化）

我想做的是有一个宏，它将根据Sheet3的a列查找Sheet1的M列中出现的每个名称，然后从Sheet3的H列返回相应的电子邮件地址

此外，它必须用分号分隔每个电子邮件地址，因为这最终将用于填充Outlook电子邮件的“收件人”字段

非常感谢您的帮助。请让我知道我是否应该在任何地方提供进一步的澄清。下面是数据的快照

| A, Sheet3       | H, Sheet3                | M, Sheet1     |
| --------------- | ------------------------ | ------------- |
| John Smith      | JohnSmith@email.com      | Frank Sinatra |
| Kimberly Jones  | Kimberly@email.com       | Corey Smith   |
| Joe Montana     | JoeMontana@email.com     | Kimberly Jones|
| Dean Martin     | DeanMartin@email.com     | John Smith    |
| Corey Smith     | Corey.Smith@email.com    |               |
| Frank Sinatra   | Frank.Sinatra@email.com  |               |

然后在Sheet1的单元格F2中，宏将生成以下内容：

Frank.Sinatra@email.com; Corey.Smith@email.com; Kimberly@email.com; JohnSmith@email.com      

工作表选项卡名称：

工作表1：

工作表3： 试试看

Function JoinEmail() As String
    Dim Ws(1 To 2) As Worksheet
    Dim vDB As Variant, vR() As Variant
    Dim vName As Variant
    Dim Dic As Object  'Dictionary
    Dim i As Long, n As Integer
    Dim s As String
    
    Set Ws(1) = Sheets(1)
    Set Ws(2) = Sheets(3)
    
    Set Dic = CreateObject("Scripting.Dictionary")
    
    vDB = Ws(2).UsedRange 'Sheets(3) data
    With Ws(1)
        vName = .Range("M2", .Range("M" & Rows.Count).End(xlUp))
    End With
    
    For i = 2 To UBound(vDB, 1)
        Dic.Add vDB(i, 1), vDB(i, 8) 'name, email
    Next i
    
    For i = 1 To UBound(vName, 1)
        s = vName(i, 1)
        If Dic.Exists(s) Then
            n = n + 1
            ReDim Preserve vR(1 To n)
            vR(n) = Dic(s)
        End If
    Next i
    If n Then
        JoinEmail = Join(vR, "; ")
    Else
        JoinEmail = ""
    End If
    
End Function

第1张图片

第3张图片

---

您可能正在寻找一个新的解决方案。哦，太棒了。谢谢你，本。我会看看我是否能找出这里发生了什么，以及如何结合XLookup…这将是我第一次做这样的事情。非常感谢你的帮助。我遇到了麻烦。我添加了几行，我将在你的帖子中用粗体字表示。请随意删除，因为我不确定它是否正确。我想我不能加粗我的编辑，因为它显示为代码，所以它只是显示在星号之间。当我运行代码时，什么都没有发生，不知道为什么只需在你的cell.hm中键入

=JoinEmail（）

。我收到一个

#NAME？

错误。我在哪个单元格或工作表中输入

=JoinEmail（）

重要吗？另外，感谢您回复到您的codenevermind，我更改了模块的名称，消除了

#name？

错误。但现在它只会产生一个空单元格，而不是你在屏幕截图中显示的内容……我会试着玩弄它