Как найти конкретные фразы в неуказанных местах и добавить в новый столбец в MS Excel

Question

Извините, если вопросы не очень объяснительные. В основном у меня есть большой лист данных о потенциальных клиентах. Данные включают в себя их адреса электронной почты, однако они немногочисленны и находятся не в определенных местах (см. Ниже). Я хотел бы создать функцию, которая будет искать фразы, содержащие слово "электронная почта" и добавить их в новый столбец.

Во время процесса, если бы функция могла убрать фразу из слова «электронная почта:», это было бы замечательно.

Пожалуйста помоги!

Пример моих данных:

Answer 1

Я думаю, что вы можете просто использовать Ctrl+F для поиска по ключевому слову определенного слова, как "электронная почта".

Answer 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».