Проверка и сплитование строки на основе регулярног выражения

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проверка и сплитование строки на основе регулярног выражения (Макросы/Sub)

Aligatro

Дата: Суббота, 27.09.2014, 22:42 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Всем привет. Пожалуй перейду сразу в общем имеется скрипт (писал не я, помогли) который по определенному признаку (коды оператора, которые указаны в массиве) отделяет мобильные номера в таблице от городских. Скрипт работает отлично, но так как он опирается на скобки возле кода (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).

Сам скрипт:
[vba]

Код

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

[/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

Код

[/vba]

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

Большое спасибо.Aligatro

К сообщению приложен файл: example2.xls (79.0 Kb)

Сообщение отредактировал Aligatro - Суббота, 27.09.2014, 22:43

Ответить

СообщениеВсем привет. Пожалуй перейду сразу в общем имеется скрипт (писал не я, помогли) который по определенному признаку (коды оператора, которые указаны в массиве) отделяет мобильные номера в таблице от городских. Скрипт работает отлично, но так как он опирается на скобки возле кода (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

Код

Автор - Aligatro
Дата добавления - 27.09.2014 в 22:42

Aligatro

Дата: Воскресенье, 28.09.2014, 06:08 | Сообщение № 2

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Я тут подшаманил немного и переработал исходный код (пару мануалов + помощь) и получилось вполне сносно и полностью подходит под мои нужды. Но возникла небольшая проблема. Вместо того, что-бы таблица расширялась на еще один доп. столбец, наоборот, замещает данные в ячейках соседнего, так как в синтасисе vba я не особо силен, то не смог детектировать проблему. Если не затруднит, посмотрите пожалуйста.

[vba]

Код

Attribute VB_Name = "SplitNumber"
Option Explicit
Private Function мобила(S As Variant)
     Dim Sl As String, bRes As Boolean, RegExp As Object, oMatches As Object, n As Integer
     S = Replace(S, " ", "")
     S = Replace(S, "-", "")
     Sl = ""
     ReDim X(1) As String
     bRes = False
     Set RegExp = CreateObject("VBScript.RegExp")
     RegExp.Global = True
     RegExp.IgnoreCase = True
     RegExp.Pattern = "\(?(039|050|063|066|067|068|091|092|093|094|095|096|097|098|099)\)?(\d{3})(\d{2})(\d{2}),?"
     bRes = RegExp.test(S)
     If bRes Then
      Set oMatches = RegExp.Execute(S)
      '  ReDim X(oMatches.Count)
      Sl = "(" & oMatches(0).subMatches(0) & ") " & oMatches(0).subMatches(1) & "-" & oMatches(0).subMatches(2) & "-" & oMatches(0).subMatches(3)
       For n = 1 To oMatches.Count - 1
       Sl = Sl & ", (" & oMatches(n).subMatches(0) & ") " & oMatches(n).subMatches(1) & "-" & oMatches(n).subMatches(2) & "-" & oMatches(n).subMatches(3)
      Next
      S = RegExp.Replace(S, "")
     End If
     X(0) = Sl: X(1) = "'" & S
     мобила = X
End Function
Private Function cityNumber(S As Variant)
     Dim Sl As String, bRes As Boolean, RegExp As Object, oMatches As Object, n As Integer
     S = Replace(S, " ", "")
     S = Replace(S, "-", "")
     S = Replace(S, "(", "")
     S = Replace(S, ")", "")
     S = Replace(S, ",", "")
     Sl = ""
     ReDim X(1) As String
     bRes = False
     Set RegExp = CreateObject("VBScript.RegExp")
     RegExp.Global = True
     RegExp.IgnoreCase = True
     RegExp.Pattern = ",?(\d{3})(\d{3})(\d{2})(\d{2}),?"
     bRes = RegExp.test(S)
     If bRes Then
      Set oMatches = RegExp.Execute(S)
      '  ReDim X(oMatches.Count)
      Sl = "(" & oMatches(0).subMatches(0) & ") " & oMatches(0).subMatches(1) & "-" & oMatches(0).subMatches(2) & "-" & oMatches(0).subMatches(3)
       For n = 1 To oMatches.Count - 1
       Sl = Sl & ", (" & oMatches(n).subMatches(0) & ") " & oMatches(n).subMatches(1) & "-" & oMatches(n).subMatches(2) & "-" & oMatches(n).subMatches(3)
      Next
      S = RegExp.Replace(S, "")
     End If
     X(0) = Sl: X(1) = "'" & S
     cityNumber = X
End Function
Private Function Town(S As Variant)
     Dim Sl As String, bRes As Boolean, RegExp As Object, oMatches As Object, n As Integer
     Sl = ""
     ReDim X(1) As String
     bRes = False
     Set RegExp = CreateObject("VBScript.RegExp")
     RegExp.Global = True
     RegExp.IgnoreCase = True
     RegExp.Pattern = "\d{5},(.*?),"
     bRes = RegExp.test(S)
     If bRes Then
      Set oMatches = RegExp.Execute(S)
      '  ReDim X(oMatches.Count)
      Sl = oMatches(0).subMatches(0)
       For n = 1 To oMatches.Count - 1
       Sl = Sl & ", " & oMatches(n).subMatches(0)
      Next
      S = RegExp.Replace(S, "")
     End If
     X(0) = Sl: X(1) = "'" & S
     Town = X
End Function
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
     'считываем в маассив данные
     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)
      RZ(R, 5) = M(R, 2)
                ' ищем города
      T = Town(M(R, 2))
      RZ(R, 3) = T(0)
      RZ(R, 4) = T(1)
      ' ищем мобильные операторы
      U = мобила(M(R, 3))
      C = cityNumber(M(R, 3))
      RZ(R, 5) = U(0)
      RZ(R, 6) = C(0)
      For i = 5 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

[/vba]

[vba]

Код

[/vba]

Aligatro

Ответить

СообщениеЯ тут подшаманил немного и переработал исходный код (пару мануалов + помощь) и получилось вполне сносно и полностью подходит под мои нужды. Но возникла небольшая проблема. Вместо того, что-бы таблица расширялась на еще один доп. столбец, наоборот, замещает данные в ячейках соседнего, так как в синтасисе vba я не особо силен, то не смог детектировать проблему. Если не затруднит, посмотрите пожалуйста.

[vba]

Код

[/vba]

Автор - Aligatro
Дата добавления - 28.09.2014 в 06:08

AndreTM

Дата: Воскресенье, 28.09.2014, 06:31 | Сообщение № 3

Группа: Друзья

Ранг: Старожил

Сообщений: 1762

Репутация: 500 ±

Замечаний: 0% ±

2003 & 2010

Ну, то есть о чём я и говорил. "Всё работает отлично, но как-то не так, как нужно"

По идее, вам продемонстрировали пример без регулярок - зачем вы будете влезать с ними? И с "последней запятой" тоже - можно было просто в хелпе посмотреть, что есть InStrRev...
Код я вам поправил на основе исходного, а не вашего, попробуйте хоть в этом варианте разобраться...
И да, "вид предприятия" тоже неплохо бы повесить на словарь, чтобы в него не отбирались всякие филиалы и пр.

И, до кучи, - доработка его же под ваши новые требования.
И зачем напрягаться с городскими телефонами? Они ищутся по принципу "всё, что не мобильное"

А адрес можно было бы тоже просто поделить по принципу "до второй запятой и после", но там ещё дописана проверка на отсутствие индекса...

[vba]

Код

Public Sub MyTest2()
Dim R, C, i, j
Dim OD: Set OD = CreateObject("Scripting.Dictionary")
Dim T: Set T = CreateObject("Scripting.Dictionary")
Dim M(), RZ(), U() As String
Dim MB
MB = Array("039", "050", "063", "066", "067", "068", "091", "092", "093", "094", "095", "096", "097", "098", "099")

For R = 0 To UBound(MB)
        T("(" & MB(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 6)

        For R = 1 To UBound(M)

            i = InStrRev(M(R, 1), ",")
            If i > 0 Then
                RZ(R, 1) = Left(M(R, 1), i - 1)
                RZ(R, 2) = Trim(Mid(M(R, 1), i + 1))
            Else
                RZ(R, 1) = M(R, 1)
            End If

                U = Split(M(R, 3), ",")
                For i = 0 To UBound(U)
                    If T.Exists(Left(LTrim(U(i)), 4)) Then
                        RZ(R, 3) = IIf(RZ(R, 3) = "", U(i), RZ(R, 3) & "," & U(i))
                    Else
                        RZ(R, 4) = IIf(RZ(R, 4) = "", U(i), RZ(R, 4) & "," & U(i))
                    End If
                Next i

            RZ(R, 5) = M(R, 2)
            i = InStr(M(R, 2), ",")
            If i > 0 Then
                j = InStr(i + 1, M(R, 2), ",")
                If j > 0 Then
                    RZ(R, 5) = Mid(M(R, 2), i + 1, j - i - 1)
                    RZ(R, 6) = LTrim(Mid(M(R, 2), j + 1))
                Else
                    RZ(R, 5) = Left(M(R, 2), i - 1)
                    RZ(R, 6) = LTrim(Mid(M(R, 2), i + 1))
                End If
            End If

        Next R

        Worksheets.Add
        Range("A1").Resize(UBound(RZ), UBound(RZ, 2)) = RZ
        Cells.Columns.AutoFit
        Cells.Rows.AutoFit

End Sub

[/vba]

И да, номера телефонов можно тоже переделать под шаблон. Допишем код:

Ну, то есть о чём я и говорил. "Всё работает отлично, но как-то не так, как нужно"

[vba]

Код

[/vba]

И да, номера телефонов можно тоже переделать под шаблон. Допишем код:

AndreTM

К сообщению приложен файл: 10-13213-1-1.xls (90.0 Kb) · 10-13213-1-2.xls (98.0 Kb)

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Сообщение отредактировал AndreTM - Воскресенье, 28.09.2014, 07:26

Ответить

СообщениеНу, то есть о чём я и говорил. "Всё работает отлично, но как-то не так, как нужно"

[vba]

Код

[/vba]

И да, номера телефонов можно тоже переделать под шаблон. Допишем код:

Автор - AndreTM
Дата добавления - 28.09.2014 в 06:31

Страница 1 из 1
1