我需要仅从Excel中的电子表格中提取电子邮件。我在StackOverflow上找到了一些示例VB代码link，礼貌Portland Runner。正则表达式提取电子邮件

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

例如：

Text         | Result 
----------------------------------------|------------------------------ 
My email address is [email protected] | My email address is 
Yes [email protected]     | 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

来源

2015-04-01 Sam Hearn

如果您在RegEx模式掩码中未指定大写和小写，但希望捕获不区分大小写的结果，那么不应将'.IgnoreCase = False'设为'.IgnoreCase = True'？ – Jeeped 2015-04-01 13:56:26

相关：http://stackoverflow.com/q/201323/1188513 – 2015-04-01 14:05:35

你说的话有道理，但改变'.IgnoreCase = False'对结果没有影响。 – 2015-04-01 14:05:39

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

尝试

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

而不是

simpleCellRegex = regEx.Replace(strInput, strReplace)

来源

2015-04-01 14:30:54

谢谢@Marcin Wesel这应该是工作，但我得到了#VALUE！错误在我的单元格中找到正确匹配的电子邮件。也许是格式问题？ – 2015-04-02 08:12:48

找出它正在寻找与您的代码匹配的第二个实例。将[1] .Value'匹配到'matches（0）.Value' – 2015-04-02 08:29:19

-1

尝试下面的模式

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

来源

2015-04-01 13:58:53 izzymo

可以更改线

simpleCellRegex = regEx.Replace(strInput, strReplace)

要

simpleCellRegex = strInput

因为您没有进行任何替换

来源

2015-04-01 14:07:14

我正在考虑沿着这条线，但实际上这只是复制单元格的值。这不是提取地址 – 2015-04-01 14:11:56

做到这一点，最简单的方法是通过安装称为KUtool软件。安装后，突出显示要提取电子邮件的内容==>点击顶部中间的ku工具==>点击文本==>提取电子邮件。您还可以使用下面的代码（ALT + F1 ==>插入模块）

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））。按回车键，您的电子邮件将被提取。希望这会有所帮助

来源

2015-12-13 06:43:58

正则表达式提取电子邮件

工作守则

回答

相关问题