mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Поиск адресов электронной почты (email) на листе Excel

Данный макрос предназначен для поиска адресов электронной почты на листе Excel, с последующим выводом найденных адресов на отдельный лист.

В прикреплённом файле, на первом листе ("исходные данные"), ячейки заполнены неструктурированной информацией (смесь фамилий, адресов почты, прочей ненужной информации)

Макрос вычленяет из текста ячеек адреса электронной почты, и выводит все найденные адреса email в таблицу на втором листе ("результат")

Конечно, не помешало бы ещё проверить все найденные адреса почты на корректность (на соответствие стандартам RFC 5322 и RFC 5321),
но в данном макросе это не реализовано (но обычно это и не требуется)

Для поиска адресов email используются регулярные выражения (RegExp)

Также рекомендуем обратить внимание на настройку для программы Парсер сайтов Сбор email на интернет-сайтах. Настройка позволяет проходить по списку сайтов и искать е-мейл на основной странице и странице контактов.

Dim coll As Collection
 
Sub EmailsList()
    Dim cell As Range: Application.ScreenUpdating = False
    Set coll = New Collection
    ' перебираем все заполненные ячейки на листе в поисках адресов почты
    For Each cell In shs.UsedRange.SpecialCells(xlCellTypeConstants).Cells
        ParseAddresses cell.Text    ' проверяем очередную ячейку
    Next cell
 
    ' выводим найденные номера на второй лист
    For Each Item In coll
        shres.Range("a" & shres.Rows.Count).End(xlUp).Offset(1) = Item
    Next
End Sub
 
Sub cl(): shres.[a4:a65000].ClearContents: End Sub    ' очистка таблицы

Sub ParseAddresses(ByVal txt As String)
    ' ищет в тексте txt адреса электронной почты,
    ' все найденные адреса добавляются в коллекцию coll
    repl1$ = "ZZZXXXZZZ": repl2$ = "ZZZYYYZZZ": On Error Resume Next
    txt = Replace(txt, ".", repl1$): txt = Replace(txt, "-", repl2$)
    Set RegExp = CreateObject("VBScript.RegExp"): RegExp.Global = True
    RegExp.Pattern = "[\w]{1,}@[\w]{1,}" & repl1$ & "[\w]{1,}"
    If RegExp.test(txt) Then
        Set objMatches = RegExp.Execute(txt)
        For i = 0 To objMatches.Count - 1
            addr = objMatches.Item(i).Value
            addr = Replace(addr, repl1$, "."): addr = Replace(addr, repl2$, "-")
            coll.Add addr, addr    ' только уникальные адреса
        Next
    End If
End Sub

ВложениеРазмерЗагрузкиПоследняя загрузка
FindEmails.xls33.5 КБ4322 дня 9 часов назад

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Готового нет, но можем попробовать сделать под заказ

Большое спасибо!!
Скажите, пожалуйста, нет ли случайно похожего волшебства, которое ищет имена в файле. То есть так же как мэйлы, только имена ?

В прикрепленном файле макрос работает без ошибок
А если хотите в своем файле запустить - надо изменить в коде имена листов:
shs меняем на worksheets(1)
shres меняем (в 2 местах) на worksheets(2)

Подскажите, пожалуйста, выводится ошибка 424. Что это значит? Что я могу не так делать?

Спасибо!

Нет, это работает в любой версии Office (по крайней мере, начиная с Excel 2003 точно)

shs.UsedRange.SpecialCells( xlCellTypeConstants ).Cells это работает только с офиса 13(

Включите макросы в Excel, как показано здесь:
http://excelvba.ru/articles/EnableMacros/Excel
(надо выбрать опцию «разрешить все макросы»)

Здравствуйте, почему то когда нажимаю запуск то выходит сообщение что надо попросить автора подписать макросы с использованием серификата, выданного центром сертификации, скажите пожалуйста как быть?
Спасибо!

В интернете много инструкций, как скопировать код макроса (и где его найти), и как назначить макросу кнопку.
Если с этим сложности - используйте прикрепленный к статье файл, - там уже все работает, только кнопку нажать.

Извините за беспокойство, очевидно вопрос совсем глупый, но до этого дня не сталкивался с макросами, и узнал о существовании оных только сейчас.Не могу разобраться как применить ваш макрос к моему файлу. под кодом нашел ссылку на загрузку вашего файла эксель. Не могли бы вы описать подробно как применить макрос к моему файлу?
Заранее спасибо.

Паттерн не учитывает, но макрос учитывает. Запустите макрос в прикреплённом файле, и увидите, что в результате есть адреса почты с тире.
Так что все нормально с кодом. не учитывает он только особо сложные email, например с пробелами или несколькими @ (но такие на практике не встречаются, хотя в теории возможны)
PS: макрос я писал давно, - видимо, плохо тогда разбирался в регулярных выражениях, либо там какие-то еще нюансы были, почему я точки и тире через замены реализовал.

Ваш паттерн не учитывает тире

OMG! Волшебство прямо!!
СПАСИБО! БОЛЬШУЩЕЕ!!! )))

Спасибо. Даже нет.... спасибоще!
Драгоценные минуты жизни спасены от рутинной работы

Просто КРАСАВЧИК!!! Человечище

Спасибо, добрый человек! Это Гениально! Так держать!!!

Спасибо автору! выручили прям очень-очень.

Огромное спасибо, просто находка!!!!!!!!!!!!!!!!

Автору большое огромадное спасибо!! я тебя люблю, дорогой мой человек

СПАСИБО ОГРОМНЕЙШЕЕ! ЦЕНЫ ВАМ НЕТ!

Громаднейшее спасибо!!!! Макрос сэкономил несколько часов (а то и дней) моей жизни:)))

Да, повторы удаляются.
В коде это даже помечено:

coll.Add addr, addr    ' только уникальные адреса

Если надо без удаления повторов, - то замените эту строку на
coll.Add addr

Спасибо огромное!
Кучу времени сэкономило просто!
Если я правильно понял, то он также ищет повторяющиеся адреса эл почты и объединяет их в один, не так ли?

а хорошая все таки идетя, с базы примеров номера фильтровать. Создать лист где будут примеры контактов ххх-хх-хх хх-ххх-хх и так далее

С номерами телефонов сложнее намного, - они могут быть в разных форматах записаны (в отличие от email - где легко найти начало и конец email)
Можем сделать за денежку, - оформляйте заказ на сайте, прикрепляйте примеры файлов, и подробно описывайте, что и как должно работать.

А можно поправить чтобы он искал номера мобильных телефонов?

Спасибо огромное !!! Сработало !!!

Огромное вам спасибо! ВЫ СУПЕР ЧЕЛОВЕК!!!!!!!!!!! =))))))))

Супер! Спасибо!

Спасибище!

Все мои макросы написаны под Windows, - потому и не работает.
Чтобы этот макрос заработал на Маке, - его надо переделывать.

Здравствуйте! К сожалению, даже не работает в вашем исходном файле: "Не удается найти макрос...". Но я работаю на Mac OS – имеет ли это значение? Спасибо!

Отличный скрипт, просто слов не нахожу, прекрасно работает, и сортирует так как мне нужно, Спасибо большое создателю скрипта

Спасибо огромное автору!!! Всё работает на 5+!

Автор красавчик! Спасибо огромнейшее!

Для поиска URL нужен шаблон посложнее, - но тоже можно сделать
Ну и, возможно, придется немного код подправить.
Пробуйте, - код открыт ведь

Грааль)))
Я такой скрипт долго искал.
А если заменить строку RegExp.Pattern = "[\w]{1,}@[\w]{1,}
на RegExp.Pattern = "[\w]{1,}www[\w]{1,}
Макрос будет выводить url вместо email?

Спасибо, все работает!

Спасибо за отзывы) Ничего никуда скидывать не надо, - макрос бесплатный, пользуйтесь на здоровье.

Спасибо большое за инструмент! Огромное! Мегареспект! Куда скинуть благодарность?

Супер! респект автору

Автор - я тебя ЛУБЛУ!!! :-))
А если взаправду спасибо за помощь!!

Респект Автору!!!!!!!!!!!! Молодец!!!!

Здравствуйте, Степан.
Скорее всего, вы скопировали кнопку запуска макроса в свой файл (возможно, вместе с листом),
и кнопке до сих пор назначен макрос из исходного файла.
Попробуйте заново назначить кнопке макрос, - и все заработает.

При нажатии кнопки "Запуск" выдаётся сообщение: Не удаётся найти макрос "FindEmails.xls"
ЭтаКнигыа.EmailsList
В чём причина?

Спасибо большое автору макроса - под мои задачи макрос оказался максимально подходящим! Все есть, не делает ничего лишнего, полностью справляется со своей задачей! Спасибо Вам большое!

Не мог не написать автору благодарность) Все работает! 6800 строк ручками не перебрать) А тут такой макросище, все решил!

ОГРОМНЕЙШЕЕ СПАСИБО!!!!!

Конечно, это задача выполнима.
Оформляйте заказ на сайте, прикрепляйте примеры файлов, подробно описывайте, что и как должно работать.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
   ___    _   _         _    ___    _____ 
/ _ \ (_) | |_ | | / _ \ | ___|
| (_) | | | | __| _ | | | | | | | |_
\__, | | | | |_ | |_| | | |_| | | _|
/_/ |_| \__| \___/ \__\_\ |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.