☰

如何在未指定位置查找特定短语并将其添加到 MS Excel 中的新列中

tag-icon • tag-icon microsoft-excel worksheet-function
如何在未指定位置查找特定短语并将其添加到 MS Excel 中的新列中

如果问题不太清楚，请见谅。基本上，我有一份关于潜在客户的大量数据表。数据包括他们的电子邮件地址，但它们很分散，而且不在固定位置（见下文）。我想创建一个函数，搜索包含单词“email”的短语，并将它们添加到新列中。

在此过程中，如果该函数可以从单词“email:”中删除短语，那就太棒了。

请帮忙！

我的数据示例：

在此处输入图片描述

答案1

我认为您只需使用Ctrl+F来搜索特定词语（如“电子邮件”）即可。

答案2

在这种情况下，VBA 是可行的方法。我整理了一些代码，您可以使用它们在工作表中搜索电子邮件地址（以“email:”开头）。它将在名为“电子邮件列表”的新工作表的一列中返回电子邮件地址。只需将以下内容粘贴到模块中并运行 Sub GatherEmails 即可。

Option Explicit
Sub GatherEmails()
Dim s1 As Worksheet, r1 As Range, s2 As Worksheet, r2 As Range
Dim tmp() As Variant, rws As Long, cols As Long, tmpStr As String
Dim tmpOut As String, output() As String
Set s1 = ActiveSheet
Set r1 = s1.UsedRange
'Load all data from sheet into array for fast processing.
tmp = r1.Value
'Loops through all values, extracts email addresses, and stores them in one space-delimited string.
For rws = 1 To UBound(tmp, 1)
    For cols = 1 To UBound(tmp, 2)
        If tmp(rws, cols) <> "" Then
            tmpStr = MatchEmails(CStr(tmp(rws, cols)))
            If tmpStr <> "" Then
                tmpOut = tmpOut & tmpStr & " "
            End If
        End If
    Next cols
Next rws
Erase tmp
'Remove trailing space from string
tmpOut = Left(tmpOut, Len(tmpOut) - 1)
'Store email addresses in an array.
output = Split(tmpOut, " ")
'Create new sheet and print array of email addresses there.
Set s2 = Sheets.Add
s2.Name = "Email List"
Set r2 = s2.Range("A1").Resize(UBound(output) + 1, 1)
r2.Value = Application.WorksheetFunction.Transpose(output)
Erase output
End Sub

Private Function MatchEmails(searchstring As String) As String
'Uses regex pattern to find email addresses preceded by "email:" and strips away "email:".
'Returns all matches in one space-delimited string.
Dim objRegex As Object, matches As Variant, i As Long
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
    .Global = True
    .Pattern = "email:([^ ]*)"
    Set matches = .Execute(searchstring)
If matches.Count > 0 Then
    For i = 1 To matches.Count
        MatchEmails = MatchEmails & .Replace(matches(i - 1).Value, "$1") & " "
    Next i
    MatchEmails = Left(MatchEmails, Len(MatchEmails) - 1)
Else
    MatchEmails = ""
End If
End With
End Function

注意：您必须添加引用才能在函数中使用正则表达式语法。在 VBA 编辑器中，转到“工具”>>“引用...”，然后选中“Microsoft VBScript 正则表达式 5.5”旁边的框。

相关内容