Это глава из книги Билла Джелена Гуру Excel расширяют горизонты: делайте невозможное с Microsoft Excel.
Задача: у вас есть ячейки, содержащие адреса электронной почты, а также другой текст. Вам нужно извлечь адреса электронной почты.
Решение: проблему можно решить с помощью макроса, пользовательской функции или мегаформулы.
Макрос
В основе макроса лежит функция VBA Split. Допустим, что ячейка содержит текст Write to lora@mrexcel.com to book a seminar. Если передать этот текст в функцию Split и указать, что текст следует разбить на элементы, разделенные пробелом – x = Split(cell.Value, " ") – VBA вернет массив, где каждое слово будет элементом массива. На рис. 1 показан массив x после использования функция Split.
Рис. 1. Функция Split возвращает массив, где каждое слово будет элементом массива
Скачать заметку в формате Word или pdf, примеры в формате Excel (с кодом VBA)
После этого макрос перебирает все элементы массива х, пока не найдет слово, соответствующее шаблону *@*.* – If x(i) Like "*@*.*" Then. Когда соответствие найдено, макрос записывает адрес электронной почты справа от исходной ячейки – cell.Offset(0, 1) = x(i). Для начала выделите все ячейки, содержащие текст (в том числе и адреса электронной почты), а затем запустите макрос:
Sub getEmailMacro()
Dim x As Variant
Dim i As Integer
Dim note As String
For Each cell In Selection
x = Split(cell.Value, " ")
For i = 0 To UBound(x)
If x(i) Like "*@*.*" Then
cell.Offset(0, 1) = x(i)
Exit For
End If
Next i
Next cell
End Sub
Адреса электронной почты записываются справа от исходного (выбранного) значения (рис. 2).
Рис. 2. Извлечение адресов электронной почты макросом
Пользовательская функция
Вы сможете адаптировать приведенный выше макрос в функцию, определяемую пользователем. Аргумент этой функции – текст, содержащий адрес электронной почты. Возвращаемое значение – сам адрес электронной почты (рис. 3).
Рис. 3. Пользовательская функция, извлекающая адрес электронной почты
Код пользовательской функции:
Public Function getEmail(note As String) As String
Dim x As Variant
Dim i As Integer
x = Split(note, " ")
For i = 0 To UBound(x)
If x(i) Like "*@*.*" Then
getEmail = x(i)
Exit Function
End If
Next i
End Function
Мегаформула
Несмотря на то, что следующая формула потребует некоторого времени на написание, она крайне умна и удивительно проста в эксплуатации: =СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(" "&A1;" ";ПОВТОР(" ";20));НАЙТИ("@";ПОДСТАВИТЬ(" "&A1;" ";ПОВТОР(" ";20)))-20;40)). Сначала
Формула изначально использует функцию ПОДСТАВИТЬ, чтобы в исходном тексте заменить каждый пробел на двадцать пробелов подряд. Это позволяет отделить каждое слово в тексте большим числом пробелов.
Первоначальный текст: now is the time for bill@mrexcel.com to buy a book
Новый текст: now is the time for bill@mrexcel.com to buy a book
Функция НАЙТИ находит знак @ в новом тексте. Функции ПСТР извлекает фрагмент текста, начинающийся за 20 символов перед @ и включающий 40 символов. Я использовал эти параметры (20 и 40), так как считаю, что их достаточно, чтобы обработать любой возможный адрес электронной почты. Да, это может привести к ошибке, если в вашей базе есть адрес типа john.jacob.jingleheimer.schmidt@gmail.com. Однако, для адресов нормального размера в итоге вы получите что-то вроде:
bill@mrexcel.com
Наконец, функция СЖПРОБЕЛЫ заменяет несколько пробелов подряд на один, а также удаляет начальные и конечные пробелы, так что в конечном итоге вы получите то, что хотели: bill@mrexcel.com (рис. 4).
Рис. 4. Мегаформула извлекает адрес электронной почты
Резюме: извлечение адреса электронной почты из ячейки, содержащей другой текст, можно выполнить с помощью макроса, пользовательской функции или мегаформулы.