Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Извлечение из ячейки со смешанными данными номера телефона и адреса электронной почты
 
#1
26.08.2015 17:10:33
Здравствуйте!

В файле содержится информация о контрагентах, и в отдельном столбце - их контакты, притом все сразу (ФИО, должность, телефон, почта).
Есть ли какие-то инструменты для извлечения телефона и почты в соседние ячейки? Это необходимо для загрузки данных  в систему, поэтому нужно привести их к одному формату. Думаю, я не первая, кто столкнулся с такой задачей, надеюсь на  Вашу помощь! :)

Вот тут есть вариант решения вопроса с эл. почтой, но он больше направлен на то, чтобы извлечь все адреса эл. почты в отдельный столбец, поэтому не будет увязки с конкретным контрагентом, а в случае многотысячного списка это бесполезная вещь...
Пробовала делить на столбцы по пробелам и запятым и затем в каждом столбце сортировать строки, содержащие по @ - очень долго, потому что в ячейке может быть длинный текст, соответственно приходится проверять до 10 столбцов, а с телефонами это вообще не сработает.

Судя по тому, что мне не удалось найти такого решения, задача не простая, но не теряю надежды...)
Заранее спасибо!
 
 
 
#2
26.08.2015 17:18:20
Для вашего случая оптимально - макросом с применением RegExp.
По RegExp я не спец, может придет кто-нибудь умный, напишет (ikki, например :) )
Только единственное, что нужно - предусмотреть все возможные маски телефонных номеров
F1 творит чудеса
 
 
 
#3
26.08.2015 17:27:29
Для электронной почты UDF в стандартный модуль
Код
Function Email(iCell As String)
    With CreateObject("vbscript.regexp")
        .Pattern = "[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"
        .Global = True
        .IgnoreCase = True
        If .test(iCell) Then
          Email = .Execute(iCell)(0).Value
        Else
          Email = "Нет в строке электронного адреса"
        End If
    End With
End Function
 
 
 
#4
26.08.2015 19:52:52
Kuzmich, ,большое спасибо!!

а еще вопрос: можно ли теоретически сделать так, чтобы данные из ячейки не просто дублировались в соседний столбец, а вырезались из ячейки? или это я уже фантазирую? :D

а для телефонов нет чего-то подобного?.... :oops: :oops: :oops:
 
 
 
#5
26.08.2015 20:23:22
Цитата
asjanechka написал: вырезались из ячейки
используйте RE (регулярное выражение) от Kuzmich
пример кода от ikki
Код
Function ikki$(s$)   
Static r As Object: If r Is Nothing Then Set r = CreateObject("vbscript.regexp"):
    r.Global = 1: r.IgnoreCase = True
    r.Pattern = "[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"
    ikki = r.Replace(s, "")
End Function

Sub t(): For Each s In [b3:b5].Cells: s.Value = ikki(s.Value): Next: End Sub
- для вывода в любую соседнюю ячейку (обрезанного текста) - использовать функцию
- для вывода в те же ячейки (изменённый текст) - запускать процедуру sub
p.s. убрала дефис в 5- строке...
Изменено: JeyCi - 26.08.2015 20:38:47
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#6
26.08.2015 20:37:31
JeyCi, , я Вам очень благодарна за помощь, но честно говоря, не очень понимаю, что мне нужно сейчас сделать...   :oops: :(  добавить Ваш код к тому, что предложил Kuzmich,?..

Наверное, глупый вопрос, но я вообще не разбираюсь в этом...  
 
 
 
#7
26.08.2015 20:41:47
Alt+F8 --> выполнить макрос t
... и разбираться...
Код
.Pattern = "[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"
это "регулярное выражение" - то, что в кавычках - то, что предложил Kuzmich - его, чуть изменив код, можно заставить вырезать (см пример)... а используя первоначальный код от Kuzmich - чтобы искать это выражение и оставлять только этот паттерн - строку с sub (с указанием нужных ячеек) добавить придётся - чтобы сначала запустить 1-ю функцию, как макрос - чтобы сначала достать эмэйлы... потом можно запускать код, вложенный мной - чтобы стереть их из ячеек источника...
p.s. делайте по примеру... (у меня проблемы с клавиатурой)
Изменено: JeyCi - 26.08.2015 20:56:09
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#8
26.08.2015 20:55:58
Как-то так
Код
Sub tt()
With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
        .Pattern = "\w+.@\w+.\w+\.\w{2,4}"
        Cells(i, 3).Value = .Execute(Cells(i, 2).Value).Item(0)
        .Pattern = "[\d+-]+"
        With .Execute(Cells(i, 2).Value)
            Cells(i, 4).Value = .Item(0)
            If .Count > 1 Then Cells(i, 5).Value = .Item(1)
        End With
    Next i
End With
End Sub
 
 
 
#9
26.08.2015 20:56:44
Для выделения городского телефона
Код
Function GorTel(iCell As String)
    With CreateObject("vbscript.regexp")
        .Pattern = "\d{3}-\d{3}-\d{2}(-|)\d{2}"
        .Global = True
        .IgnoreCase = True
        If .test(iCell) Then
          GorTel = .Execute(iCell)(0).Value
        Else
          GorTel = "Нет в строке городского телефона"
        End If
    End With
End Function
Изменено: Kuzmich - 26.08.2015 21:07:11
 
 
 
#10
26.08.2015 21:00:56
Kuzmich, исходя из приведенного примера, номера записаны как попало, поэтому шаблон "\d{3}-\d{3}-\d{2}(-|)\d{2}" может не подойти
 
 
 
#11
26.08.2015 21:10:59
МВТ это я имел ввиду городские телефоны, начинающиеся на 495
 
 
 
#12
26.08.2015 21:17:12
Kuzmich, понятно, просто там не только такие были :)
 
 
 
#13
26.08.2015 21:35:02
Всем большое-пребольшое спасибо, лучи добра и вообще!
Пока не очень поняла, что куда и как, но на примере все работает, супер!!!
офисный планктон ликует  :D

Еще бы с телефонами такую же штуку провернуть...  ;)
 
 
 
#14
26.08.2015 21:38:57
asjanechka, так я, вроде, с телефонами делал. Не работает?
 
 
 
#15
26.08.2015 23:08:45
МВТ, , не могу попробовать, пока не понимаю, как ) как проверю - напишу
а эта штука тоже вырезает или только переносит в соседний столбец?
 
 
 
#16
27.08.2015 06:18:14
asjanechka, переносит в соседние столбцы почту и телефоны. Но можно переделать, чтобы вырезало
Код
Sub tt()
On Error Resume Next
With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
        .Pattern = "\w+.@\w+.\w+\.\w{2,4}"
        Cells(i, 3).Value = .Execute(Cells(i, 2).Value).Item(0)
        .Pattern = "[\d+-]+"
        With .Execute(Cells(i, 2).Value)
            Cells(i, 4).Value = .Item(0)
            If .Count > 1 Then Cells(i, 5).Value = .Item(1)
        End With
        Cells(i, 2) = Application.WorksheetFunction.Trim( _
        Replace(Replace(Replace(Replace(Cells(i, 2), Cells(i, 3), ""), Cells(i, 4), ""), "äîá.", ""), Cells(i, 5), ""))
    Next i
End With
End Sub
 
 
 
#17
27.08.2015 11:12:00
МВТ, да, проверила, работает! хоть и не везде четко, но все равно это уже очень большая помощь.
и еще, небльшое уточнение. Правильно ли я понимаю, что эта штука работает, только если контакты записаны в столбце В, и разносит их на соседние C,D,E?

Огромная благодарность от меня и многих клерков, которых я не знаю, но уверена, они зайдут сюда и воспользуются...)
 
 
 
#18
27.08.2015 11:16:53
Cells(номер_строки, номер_столбца)

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#19
27.08.2015 19:12:09
asjanechka, нарисуйте реальный пример: где данные и куда их расставлять?
 
 
 
#20
28.08.2015 00:35:14
МВТ, в реальном примере нужно из ячейки D вставить в E, F. Но это не столь существенно, т.к. в других файлах может быть иначе, и нет смысла под каждый затачивать, наверное, можно и на отдельном листе все это провернуть...)  и насколько я поняла из комента JayBhagavan, мне надо в коде изменить циферки после cells на те номера столбцов, куда мне надо вырезать, верно?

Меня больше смущает то, что не всегда верно распознаются эл. адреса и телефоны (например,из  ivan.petrov@mail.ru берет только petrov@mail.ru или из gg1234-bb@mail.ru берет bb@mail.ru, а цифери вообще как телефон распознает, или в случае с телефонами почему-то в некоторых случаях выдирает по одной цифре из кода, а остальное оставляет :D ), но понимаю, что сложно предугадать все нюансы, это уже вручную сделаю)
 
 
 
#21
28.08.2015 00:42:58
Цитата
Меня больше смущает то, что не всегда верно распознаются эл. адреса
А вы попробуйте мой вариант извлечения адреса электронной почты
 
 
 
#22
28.08.2015 00:52:41
Kuzmich, Ваш вариант тоже не узнает такие телефоны, когда код отделен от номера пробелом (например, 8 111 234 6775)...
 
 
 
#23
28.08.2015 00:55:08
Я говорил про адреса электронной почты
 
 
 
#24
28.08.2015 01:01:14
Цитата
asjanechka написал:
Меня больше смущает то, что не всегда верно распознаются эл. адреса и телефоны (например,из  ivan.petrov@mail.ru берет только petrov@mail.ru или из gg1234-bb@mail.ru берет bb@mail.ru
достаточно чуть дополнить первый шаблон в коде МВТ:
Код
.Pattern = "[\w.-]+.@\w+.\w+\.\w{2,4}"
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#25
28.08.2015 01:10:18
Kuzmich, извините, не поняла вас! проверила, все работает!
ikki, спасибо, все получилось, юху! :)
 
 
 
#26
28.08.2015 01:12:58
и выкладывайте примеры тех вариантов, где макрос сработал не совсем желаемым образом
гарантировать ничего нельзя, но, возможно, что-то получится подправить.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#27
28.08.2015 01:32:50
email'ы: не распознал blabla.xx@bk.ru, хотя с аналогичными (с точкой посередине) справлялся. Может, дело в bk?..

с телефонами косяки из-за пробела, например, из номера 7 495 2223344 в первый столбец берет 7, а во второй 495. Но это уж вряд ли исправишь, иначе наверное вообще все в кучу будет мешать...

пока вроде все, что нашла, в остальном все получается :)
 
 
 
#28
28.08.2015 09:24:39
Цитата
не распознал blabla.xx@bk.ru, хотя с аналогичными (с точкой посередине) справлялся
В моем варианте выделил адрес
 
 
 
#29
28.08.2015 10:32:11
8-0 а у меня не выделяет, взгляните, пожалуйста :oops:
 
 
 
#30
28.08.2015 10:54:43
Я же вам написал - в моем варианте выделяет.
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх