Question

我必须在名称和电子邮件地址组合的列中提取客户名称。此列中显示的内容示例如下：

John Smith Johnsmith@me.com

Joe Bloggs theycallmejoe@myemail.com

Justin Credible JustinC@provider.com

我找到了这个很酷的VBA来提取电子邮件地址。

Function ExtractEmailAddress(s As String) As String
    Dim AtSignLocation As Long
    Dim i As Long
    Dim TempStr As String
    Const CharList As String = "[A-Za-z0-9._-]"

    'Get location of the @
    AtSignLocation = InStr(s, "@")
    If AtSignLocation = 0 Then
        ExtractEmailAddress = "" 'not found
    Else
        TempStr = ""
        'Get 1st half of email address
        For i = AtSignLocation - 1 To 1 Step -1
            If Mid(s, i, 1) Like CharList Then
                TempStr = Mid(s, i, 1) & TempStr
            Else
                Exit For
            End If
        Next i
        If TempStr = "" Then Exit Function
        'get 2nd half
        TempStr = TempStr & "@"
        For i = AtSignLocation + 1 To Len(s)
            If Mid(s, i, 1) Like CharList Then
                TempStr = TempStr & Mid(s, i, 1)
            Else
                Exit For
            End If
        Next i
    End If
    'Remove trailing period if it exists
    If Right(TempStr, 1) = "." Then TempStr = _
       Left(TempStr, Len(TempStr) - 1)
    ExtractEmailAddress = TempStr
End Function

但我需要类似的东西来提取名字。

有人可以帮忙吗？

Answer 1

只需另外一个小功能即可通过删除电子邮件地址来获取名称。见下文......

在工作表中使用功能。

Function GetName(refCell As String)
Dim tempName As String
    tempName = Trim(Left(refCell, Len(refCell) - Len(ExtractEmailAddress(refCell))))
    GetName = tempName
End Function

'----------------------------------------------------------

Function ExtractEmailAddress(s As String) As String
    Dim AtSignLocation As Long
    Dim i As Long
    Dim TempStr As String
    Const CharList As String = "[A-Za-z0-9._-]"

    'Get location of the @
    AtSignLocation = InStr(s, "@")
    If AtSignLocation = 0 Then
        ExtractEmailAddress = "" 'not found
    Else
        TempStr = ""
        'Get 1st half of email address
        For i = AtSignLocation - 1 To 1 Step -1
            If Mid(s, i, 1) Like CharList Then
                TempStr = Mid(s, i, 1) & TempStr
            Else
                Exit For
            End If
        Next i
        If TempStr = "" Then Exit Function
        'get 2nd half
        TempStr = TempStr & "@"
        For i = AtSignLocation + 1 To Len(s)
            If Mid(s, i, 1) Like CharList Then
                TempStr = TempStr & Mid(s, i, 1)
            Else
                Exit For
            End If
        Next i
    End If
    'Remove trailing period if it exists
    If Right(TempStr, 1) = "." Then TempStr = _
       Left(TempStr, Len(TempStr) - 1)
    ExtractEmailAddress = TempStr
End Function

您也可以使用内置函数代替GetName ExtractEmailAddress

=TRIM(LEFT(A1,LEN(A1)-LEN(ExtractEmailAddress(A1))))

Answer 2

仅公式方法依赖于有关查找单元格中最后一个空格的Super User答案。然后，您只需使用LEFT(position_of_last_space-1)即可获取电子邮件地址左侧的所有内容。

=LEFT(A1,FIND("`",SUBSTITUTE(A1," ","`",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))-1)

反蜱的使用是替代空间。假设名称或电子邮件地址都没有回拨。

示例：

Answer 3

您是否尝试过这种名为Flash Fill

的非VBA解决方案

如果您有相同模式的数据（例如您要提取名字的电子邮件地址），则：

在下一栏中写下您要提取的内容的示例（即您示例中的John Smith）：
选择该单元格，然后按Ctrl + E
您将获得可以进一步检查的列表。

从excel

3 个答案: