Aligatro
@Aligatro
Turn food and coffee into software...

Как в VBA скрипт для excel вставить проверку по регулярному выражению?

Всем привет. Пожалуй перейду сразу в общем имеется скрипт (писал не я, помогли) который по определенному признаку (коды оператора, которые указаны в массиве) отделяет мобильные номера в таблице от городских. Скрипт работает отлично, но так как он опирается на скобки возле кода (050), иногда случаются ложные срабатывания. Я хотел бы попросить помощи у тех кто разбирается в VBA, помогите пожалуйста переделать скрипт так, что бы он детектировал номера не по скобочкам, а по следующему регулярному выражению:

\b\(?(039|050|063|066|067|068|091|092|093|094|095|096|097|098|099)\)?\s?\-?\d{3}\s?\-?\d{2}\s?\-?\d{2}\b

Единственное, я не совсем уверен в верности регулярки, кажется я ошибся с окончанием строки (\b).

Сам скрипт:
Public Sub QWERT()
Dim R, C, i
Dim OD: Set OD = CreateObject("Scripting.Dictionary")
Dim T: Set T = CreateObject("Scripting.Dictionary")
Dim M(), RZ(), U() As String
Dim MB
M = Array(39, 50, 63, 66, 67, 68, 91, 92, 93, 94, 95, 96, 97, 98, 99)

'закидываем в словарь префиксы
For R = 0 To UBound(M)
    T("(0" & M(R) & ")") = 1
Next R

'считываем в маассив данные
With Ëèñò1
    M = .Range("A1:G" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
    ReDim RZ(1 To UBound(M), 1 To UBound(M, 2) + 2)
    
'перебираем все строки массива
    For R = 1 To UBound(M)
'    отделяеем название фирмы
        If InStr(1, M(R, 1), ",") > 0 Then
            C = Split(M(R, 1), ",")(0)
            RZ(R, 1) = C
            RZ(R, 2) = Replace(M(R, 1), C & ",", "")
        Else
            RZ(R, 1) = M(R, 1)
        End If
            RZ(R, 3) = M(R, 2)
' ищем мобильные операторы

            U = Split(M(R, 3), ",")
            For i = 0 To UBound(U)
            Debug.Print i, UBound(U), U(i), R
                If T.Exists(Left(U(i), 5)) Then
                    RZ(R, 4) = IIf(RZ(R, 4) = "", U(i), RZ(R, 4) & "," & U(i))
                Else
                    RZ(R, 5) = IIf(RZ(R, 5) = "", U(i), RZ(R, 5) & "," & U(i))
                End If
            Next i
            For i = 4 To UBound(M, 2)
                RZ(R, i + 2) = M(R, i)
            Next i
    Next R
    Worksheets.Add
    Range("A1").Resize(UBound(RZ), UBound(RZ, 2)) = RZ
    Cells.Columns.AutoFit
    Cells.Rows.AutoFit

End Sub


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

Большое спасибо.
  • Вопрос задан
  • 3047 просмотров
Решения вопроса 2
@rosperitus
Вот глянь по ссылке, должно помочь www.script-coding.com/WSH/RegExp.html
Ответ написан
Комментировать
Aligatro
@Aligatro Автор вопроса
Turn food and coffee into software...
На всякий случай поделюсь ссылкой готовой формы, если вдруг кто-то перейдет на этот вопрос с поиска - habrahabr.ru/post/239369
Ответ написан
Комментировать
Пригласить эксперта
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Похожие вопросы