Excel:使用空格分隔提取的电子邮件

时间:2017-05-10 16:12:21

标签: excel excel-vba excel-formula vba

我使用excel宏从更长的字符串中提取电子邮件(即'将提取电子邮件joe@email.com' - 仅返回' joe@email.com& #39;),唯一的问题是如果字符串中有两封电子邮件,它会将它们作为一个大字符串返回,如下所示:' joe @ email.combob @ email.com'。我想要的是将它归还:' joe@email.com bob@email.com'。我将提供我用来执行此操作的功能,并希望有人知道如何在其当前状态下修改它以使其按空格分隔电子邮件。

Function ExtractEmailFun(extractStr As String) As String
'Update 20130829
Dim CharList As String
On Error Resume Next
CheckStr = "[A-Za-z0-9._-]"
OutStr = ""
Index = 1
Do While True
    Index1 = VBA.InStr(Index, extractStr, "@")
    getStr = ""
    If Index1 > 0 Then
        For p = Index1 - 1 To 1 Step -1
            If Mid(extractStr, p, 1) Like CheckStr Then
                getStr = Mid(extractStr, p, 1) & getStr
            Else
                Exit For
            End If
        Next
        getStr = getStr & "@"
        For p = Index1 + 1 To Len(extractStr)
            If Mid(extractStr, p, 1) Like CheckStr Then
                getStr = getStr & Mid(extractStr, p, 1)
            Else
                Exit For
            End If
        Next
        Index = Index1 + 1
        If OutStr = "" Then
            OutStr = getStr
        Else
            OutStr = OutStr & Chr(10) & getStr
        End If
    Else
        Exit Do
    End If
Loop
ExtractEmailFun = OutStr
End Function

提前致谢!

2 个答案:

答案 0 :(得分:1)

如果您希望替换当前输出字符串中的换行符,该字符串看起来像

  

joe@email.com
  bob@email.com

带空格,看起来像

  

joe@email.com bob@email.com

你可以简单地改变

This
is
tt
sentence

public void fillHashMap() {
    for(String line : lines) {
        String [] fields = line.split(";");
        UniversityScores us = new UniversityScores(fields[0], fields[1], fields[2], fields[3]);

       if (scores.keySet().contains(us.getScore())) {
           scores.get(us.getScore()).add(us);
       }
       else {
           ArrayList<UniversityScores> t = new ArrayList<UniversityScores>();
           t.add(us);
           scores.put(us.getScore(), t);
       }
    }

}

答案 1 :(得分:0)

似乎可以更有效地完成这项工作。我同意@nbayly Split的空间角色,迭代&#34;单词&#34;如果&#34;字&#34;包含@,您可以放心地将其视为电子邮件地址。

Function GetEmails(words$)

Dim word
Dim emails As Object
Set emails = CreateObject("Scripting.Dictionary")

For Each word In Split(words, " ")
    'Strip characters that you don't like:
    word = Replace(word, "'", "")
    word = Replace(word, ",", "")
    word = Replace(word, ")", "")
    word = Replace(word, "(", "")
    'etc...
    word = Trim(word)
    'Get rid of trailing periods
    word = IIf(Right(word, 1) = ".", Left(word, Len(word) - 1), word)
    If InStr(1, word, "@") <> 0 Then
        'This is probably an email address
        ' adds to the dictionary
        emails(word) = word
    Else
        'This is not an email address, do nothing
    End If
Next

GetEmails = Join(emails.Keys(), " ")

End Function