Страницы: 1
RSS
Убрать лишний текст из телефонных номеров
 
У меня есть большая переписка с телефонными номерами,мне нужно из этой переписки извлечь все номера.
Или как удалить лишний текст?
Помогите пожалуйста!!!
 
Файл-пример, пожалуйста.
Вот горшок пустой, он предмет простой...
 
Так нужно 5-6 документов обработать
 
В примере нужно отобразить не только исходные данные, но и результат, который вы хотите получить.
Из первого поста можно понять что вам нужно оставить только ячейки с номерами без привязки к имени. Это так?
Вот горшок пустой, он предмет простой...
 
PooHkrd,да,оставить только мобильные номера.  
 
Какая у вас версия Excel?
Вот горшок пустой, он предмет простой...
 
2016 16.0.4266
 
Если в столбце признак номера = "Оно", то в столбце "Только числа"  указан номер телефона. Если в признаке написано ХЗ, то в столбцах Номер  для фильтрации указаны возможные варианты, которые вы сможете быстро  отсеять вручную.
Фильтровалось все через запрос Power Query.
Если уж вам совсем лениво добить парсинг вручную, то можно будет дописать критерии и для остальных столбцов, но это будет позже, сейчас некогда.
Изменено: PooHkrd - 23.08.2017 12:26:18
Вот горшок пустой, он предмет простой...
 
Код
Function telefon$(s$)
    Static objRegExp As Object
    Dim objMatch As Object
    Dim ss$, x
    If objRegExp Is Nothing Then
        Set objRegExp = CreateObject("VBScript.RegExp")
        objRegExp.Global = True: objRegExp.IgnoreCase = True: objRegExp.MultiLine = True
    End If
    With objRegExp
        .Pattern = "(\[.*]|[^a-zа-яё\d])"
        If .test(s) Then
            s = .Replace(s, "")
            .Pattern = "\d{10,11}"
            If .test(s) Then
                Set objMatch = .Execute(s)
                For Each x In objMatch
                    x = IIf(Left$(x, 1) = 7, "+" & x, x)
                    ss = ss & ", " & x
                Next
                ss = Mid$(ss, 3)
            End If
        End If
    End With
    telefon = ss
End Function

Но из этой кучи мусора все равно лишнее прихватывает.
 
еще вариант функции
 
Код
Function uuu$(t$)
 Dim t1$
 With CreateObject("VBScript.RegExp"): .Pattern = "(\+7|[-\d\s\)\(]+"
  If .test(t) Then t1 = .Execute(t)(0) Else t1 = ""
  .Pattern = "[-\(\)\s]": .Global = True
  t1 = .Replace(t1, ""): .Pattern = "(\+7|8)\d{10}"
 If .test(t1) Then uuu = .Execute(t1)(0) Else uuu = ""
 End With
End Function
Изменено: sv2013 - 23.08.2017 18:47:59
Страницы: 1
Наверх