Ситуация следующая. Есть файл с клиентской базой (прикрепил), там в строках определенного столбца указывается информация о клиентах в том числе и email. Нужен макрос который бы автоматически извлекал адреса электронки которые содержатся на странице и формировал отдельный список. Порыскав по просторам рунета нашел следующий код: [vba]
Код
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
[/vba]
Теперь не могу нормально записать этот макрос (не умею попросту), либо сам код неверный, но когда выполняю макрос появляется ошибка - "runtime error 424 object required". Помогите пожалуйста, подскажите, что мне пошагово нужно сделать.
Добрый день, Уважаемые Форумчане!
Ситуация следующая. Есть файл с клиентской базой (прикрепил), там в строках определенного столбца указывается информация о клиентах в том числе и email. Нужен макрос который бы автоматически извлекал адреса электронки которые содержатся на странице и формировал отдельный список. Порыскав по просторам рунета нашел следующий код: [vba]
Код
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
[/vba]
Теперь не могу нормально записать этот макрос (не умею попросту), либо сам код неверный, но когда выполняю макрос появляется ошибка - "runtime error 424 object required". Помогите пожалуйста, подскажите, что мне пошагово нужно сделать.gsnejniy
В редакторе макросов VBE в меню Tools выбрать пункт References.. Найти в списке пункт Microsoft VBScript Regular Expressions 5.5 в открывшемся диалоговом окне, поставить возле него галочку и нажать кнопку OK.
Насколько знаю ни одно рег. выражение не даёт 100% гарантии, что не выкинет валидный адрес, об этом куча статей в инете
Проверить подключена ли библиотека
Цитата
В редакторе макросов VBE в меню Tools выбрать пункт References.. Найти в списке пункт Microsoft VBScript Regular Expressions 5.5 в открывшемся диалоговом окне, поставить возле него галочку и нажать кнопку OK.
Насколько знаю ни одно рег. выражение не даёт 100% гарантии, что не выкинет валидный адрес, об этом куча статей в инете Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Добрый день! Используя ваше рег. выражение, можно так: (UDF) [vba]
Код
Function GetEMail(ByVal Value As String) As String With CreateObject("VBScript.RegExp") .Pattern = "[\w]{1,}@[\w]{1,}\.[\w]{2,}" With .Execute(Value) If .Count Then GetEMail = .Item(0) End With End With End Function
[/vba]
[p.s.]но можно и без рег. выражений[/p.s.]
Добрый день! Используя ваше рег. выражение, можно так: (UDF) [vba]
Код
Function GetEMail(ByVal Value As String) As String With CreateObject("VBScript.RegExp") .Pattern = "[\w]{1,}@[\w]{1,}\.[\w]{2,}" With .Execute(Value) If .Count Then GetEMail = .Item(0) End With End With End Function
Добрый день! Используя ваше рег. выражение, можно так: (UDF)
У Вас судя по всему все получилось. Объясните мне пожалуйста, что мне пошагово нужно сделать чтобы у меня тоже вышло, я честно признаться в макросах дуб дубом)
Добрый день! Используя ваше рег. выражение, можно так: (UDF)
У Вас судя по всему все получилось. Объясните мне пожалуйста, что мне пошагово нужно сделать чтобы у меня тоже вышло, я честно признаться в макросах дуб дубом)gsnejniy
Объясните мне пожалуйста, что мне пошагово нужно сделать чтобы у меня тоже вышло
В сообщении, во вложенном архиве, ваш файл - откройте его, в ячейках столбца N прописана пользовательская функция GetEMail, нажмите Alt+F11, в открывшемся окне VBE увидите код этой пользовательской функции (или можете код прямо из сообщения скопировать), вставьте этот код в стандартный модуль своего рабочего файла и в нужных ячейках можете прописывать функцию GetEMail, по аналогии с вашим файлом-примером.
Объясните мне пожалуйста, что мне пошагово нужно сделать чтобы у меня тоже вышло
В сообщении, во вложенном архиве, ваш файл - откройте его, в ячейках столбца N прописана пользовательская функция GetEMail, нажмите Alt+F11, в открывшемся окне VBE увидите код этой пользовательской функции (или можете код прямо из сообщения скопировать), вставьте этот код в стандартный модуль своего рабочего файла и в нужных ячейках можете прописывать функцию GetEMail, по аналогии с вашим файлом-примером.KSV
Я просто не уверен, что правильно могу его в файл записать,
Как в Простоквашино. "Для того, чтобы что-то ненужное продать, нужно сначала это ненужное купить" Сделали не правильно, показали, а после спрашивайте, что не правильно.
Я просто не уверен, что правильно могу его в файл записать,
Как в Простоквашино. "Для того, чтобы что-то ненужное продать, нужно сначала это ненужное купить" Сделали не правильно, показали, а после спрашивайте, что не правильно.RAN