从一列中查找每个值并返回带有“;"的电子邮件地址的宏分隔器 [英] Macro that looks up each value from one column and returns email address with ";" separator

问题描述

实际上有人使用公式为我解决了这个问题，

工作表 1:

工作表 3:

解决方案

尝试，

函数 JoinEmail() As StringDim Ws(1 to 2) 作为工作表Dim vDB 作为变体，vR() 作为变体将 vName 调暗为变体Dim Dic As Object 'DictionaryDim i As Long, n As IntegerDim s 作为字符串设置 Ws(1) = Sheets(1)设置 Ws(2) = Sheets(3)Set Dic = CreateObject(Scripting.Dictionary")vDB = Ws(2).UsedRange 'Sheets(3) 数据与 Ws(1)vName = .Range(M2", .Range(M"& Rows.Count).End(xlUp))结束于对于 i = 2 到 UBound(vDB, 1)Dic.Add vDB(i, 1), vDB(i, 8) 'name, email接下来我对于 i = 1 到 UBound(vName, 1)s = vName(i, 1)如果 Dic.Exists(s) 那么n = n + 1ReDim Preserve vR(1 To n)vR(n) = Dic(s)万一接下来我如果 n 那么JoinEmail = Join(vR, "; ")别的JoinEmail = "";万一结束函数

Sheet1 图像

Sheet3 图片

Someone actually solved this problem for me using a formula, which can be found here. Unfortunately, I need a solution that works Excel 2016, and it seems like VBA is the best/only route.

Would really appreciate any help

Legend: (this is across multiple worksheets in the same workbook)

Each column has a header.
Column A of Sheet3: List of Names
Column H of Sheet3: List of Email Addresses
Column M of Sheet1: contains the below formula dragged down, which produces a variable number of rows of data: =IFERROR(INDEX($A$2:$A$42,MATCH(0,IF("1"=$L$2:$L$42,COUNTIF($O$1:$O1,$A$2:$A$42),""),0)),"")

In column M of Sheet1, I have an Index/Match formula, which populates with a list of people's names. (as said above, the number of names that appears is ever-changing)

What I'd like to do is have a macro which will look up each name that appears in column M of Sheet1 against column A of Sheet3 and then return with the respective email address from column H of Sheet3.

Additionally, it would have to separate each email address with a semicolon, as this is ultimately going to be used to populate the To field of an Outlook email.

Would really appreciate any help. Please let me know if I should provide further clarifications anywhere. Below is a snapshot of what the data looks like

| A, Sheet3       | H, Sheet3                | M, Sheet1     |
| --------------- | ------------------------ | ------------- |
| John Smith      | [e-mail]      | Frank Sinatra |
| Kimberly Jones  | [e-mail]       | Corey Smith   |
| Joe Montana     | [e-mail]     | Kimberly Jones|
| Dean Martin     | [e-mail]     | John Smith    |
| Corey Smith     | [e-mail]    |               |
| Frank Sinatra   | [e-mail]  |               |

And then in the cell F2 of Sheet1, the macro would produce the below:

[e-mail]; [e-mail]; [e-mail]; [e-mail]      

Worksheet tab names:

Worksheet1:

Worksheet3:

解决方案

Try,

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

Sheet1 image

Sheet3 image

这篇关于从一列中查找每个值并返回带有“;"的电子邮件地址的宏分隔器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！