Question

使用Excel2013。多年的寻找和适应后，我的第一篇文章。

我正在尝试将当前的App用户（即“ John Smith”）与他的电子邮件地址“ jsmith@work.com”进行匹配。

使用两个字符串：1个用于用户（1到3），另一个eaddress（1到3）。我想获取当前用户的电子邮件地址，以在单独的Sub中使用，该Sub在电子邮件中抄送当前用户。

我尝试了For Each i In user，并将eName设置为eaddress(i)。这仅返回列出的 last 用户/电子邮件。

Private Sub (useremail)
Dim user (1 To 3), eaddress (1 To 3), fullName, eName As String

fullName = Application.UserName
user(1) = "John Smith"
user(2) = "Debbie Adams"
user(3) = "Karen Jones"

eaddress(1) = "jsmith@work.com"
eaddress(2) = "dadams@work.com"
eaddress(3) = "kjones@work.com"

For i = 1 To 3
    'For Each i In user
        fullName = user(i)
        eName = eaddress(i)
    'Exit For
    debug.print "User is " & fullname & "email to " & eName
Next i

试图获取当前用户的eaddress / eName（用于在单独的Sub to email文件中使用）。

Answer 1

您可以使用Dictionary来简化此操作

Private Sub UsereMail()
    Dim dictInfo, fullName

    fullName = Application.UserName

    Set dictInfo = CreateObject("Scripting.Dictionary")
    dictInfo.Add "John Smith", "jsmith@work.com"
    dictInfo.Add "Debbie Adams", "dadams@work.com"
    dictInfo.Add "Karen Jones", "kjones@work.com"

    If dictInfo.Exists(fullName) Then
        Debug.Print "User is " & fullName & " email to " & dictInfo(fullName)
    End If
End Sub

Answer 2

使用原始的基于数组的方法：

Sub tester()
    Debug.Print "John Smith", UserEmail("John Smith") '>> jsmith@work.com
    Debug.Print "John Brown", UserEmail("John Brown") '>> [blank]
End Sub


Private Function UserEmail(userName As String) As String

    Dim user(1 To 3), eaddress(1 To 3), m

    user(1) = "John Smith"
    user(2) = "Debbie Adams"
    user(3) = "Karen Jones"

    eaddress(1) = "jsmith@work.com"
    eaddress(2) = "dadams@work.com"
    eaddress(3) = "kjones@work.com"

    m = Application.Match(userName, user, 0)
    If Not IsError(m) Then UserEmail = eaddress(m)

End Function

Answer 3

另一种基于字典的方法，其中用户列表不必与电子邮件地址的顺序相同。

Option Explicit

Sub Test()
Dim user(1 To 3)            As String
Dim eaddress(1 To 3)        As String
Dim user_dic                As Scripting.Dictionary

user(1) = "John Smith"
user(2) = "Debbie Adams"
user(3) = "Karen Jones"

eaddress(1) = "jsmith@work.com"
eaddress(2) = "dadams@work.com"
eaddress(3) = "kjones@work.com"

Set user_dic = MatchUsersToEmail(eaddress, user)

Debug.Print eaddress(1), user_dic.Item(eaddress(1))
Debug.Print eaddress(2), user_dic.Item(eaddress(2))
Debug.Print eaddress(3), user_dic.Item(eaddress(3))

End Sub

Public Function MatchUsersToEmail(ByRef email_array() As String, ByRef user_array() As String) As Scripting.Dictionary
' Returns a scripting dictionary where the email address returns the user name
Dim my_users                As Scripting.Dictionary
Dim my_user                 As Variant
Dim my_email                As Variant
Dim my_name()               As String
Dim my_key                  As String
    Set my_users = New Scripting.Dictionary

    For Each my_email In email_array
        ' Add the email address as the key
        my_users.Add Key:=CStr(my_email), Item:=vbNullString

    Next

    For Each my_user In user_array
        my_name = Split(LCase$(my_user))
        my_key = Left$(my_name(0), 1) & my_name(1) & "@work.com"
        my_users.Item(my_key) = my_user

    Next

    Set MatchUsersToEmail = my_users

End Function

将用户名（数组）匹配到电子邮件（数组）

3 个答案: