工作代码

Question

我只需从Excel中的电子表格中提取电子邮件。我在StackOverflow link 上找到了一些示例VB代码，由Portland Runner提供。

我创建了一个Excel模块，它似乎工作正常，除了。它只返回地址的第一个大写字符到单元格并忽略电子邮件。

例如：

Text                                    | Result
----------------------------------------|------------------------------
My email address is address@gmail.com   | My email address is  
Yes  Address@gmail.com                  | Yes  A

以下是我正在使用的代码：

Function simpleCellRegex(Myrange As Range) As String
    Dim regEx As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String


    strPattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"

    If strPattern <> "" Then
        strInput = Myrange.Value
        strReplace = ""

        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = strPattern
        End With

        If regEx.test(strInput) Then
            simpleCellRegex = regEx.Replace(strInput, strReplace)
        Else
            simpleCellRegex = "Not matched"
        End If
    End If
End Function

我没有足够的VB经验可以真正诊断出这里可能发生的事情，希望有人能够发现我做错了什么。

工作代码

Function simpleCellRegex(Myrange As Range) As String
Dim regEx As New RegExp
Dim strPattern As String
Dim strInput As String
Dim strReplace As String
Dim strOutput As String


strPattern = "[A-Za-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-zA-Z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"

If strPattern <> "" Then
    strInput = Myrange.Value
    strReplace = ""

    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = strPattern
    End With

    If regEx.Test(strInput) Then
        Set matches = regEx.Execute(strInput)
        simpleCellRegex = matches(0).Value
    Else
        simpleCellRegex = "Not matched"
    End If
End If
End Function

Answer 1

您可以更改

行

 simpleCellRegex = regEx.Replace(strInput, strReplace)

到

 simpleCellRegex = strInput

因为您没有进行任何替换

Answer 2

返回strInput时，只需输入与输入相同的字符串。您需要返回使用RegExp找到的值。

尝试

Set matches = regEx.Execute(strInput)
simpleCellRegex = matches(1).Value

而不是

simpleCellRegex = regEx.Replace(strInput, strReplace)

Answer 3

最简单的方法是安装名为KUtool的软件。安装后，突出显示要提取电子邮件的内容==＆gt;点击顶部中间的ku工具==＆gt;点击文字==＆gt;提取电子邮件。您还可以使用以下代码。（ALT + F1 ==＆gt; INSERT MODULE）

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 Ifenter code here
Loop
ExtractEmailFun = OutStr
End Function

您也可以采用代码方式打开excell，点击ALT + F1，点击插入模块并粘贴此代码

单击“保存”并在空白单元格中输入公式（Column = ExtractEmailFun（A1））。按Enter键，您的电子邮件将被提取。希望这会有所帮助

Answer 4

尝试以下模式

strPattern  = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"

RegEx提取电子邮件

工作代码

4 个答案: