Страницы: 1
RSS
Работа с адресами с помощью регулярных выражений.
 
Добрый день!

Возможно ли с помощью регулярных выражений:

1) Все отдельностоящие слова полностью из заглавных букв сделать в формате Первая Буква Заглавная (Proper).
Например: «НОВЫЙ СВЕТ СоЛнЦе Луч9 20 САДОВОДСТВО дорога» превратить в: «Новый Свет СоЛнЦе Луч9 20 Садоводство дорога» ?

2) Вытащить улицу и номер дома часто можно с помощью следующего правила:
смотрим первую попадающуюся цифру в строке и берем то слово перед ней, которое попадается первым написанным с большой буквы.
Пример: «Санкт-Петербург, Обводный канал 45/1 строение 25Б Литер М» вытащит строку «Обводный 45»., потому что 45 - первая цифра в строке. Обводный - первое написанное с заглавной буквы перед 45.

3) Есть улицы-исключения в их название входит цифра (пример: 8 линия В.О. д.10)
У меня имеется список исключеений. Как для них сделать чтобы они вытащили ближайшее впереди и ближайший сзади номер?
Например "Санкт-Петербург г. 8-я Красноармейская ул. 27 кв.40" -> "8 Красноармейская 27"
(?:Кадетская|линия|Советская|Рабфаковский|Предпортовый|Января|Красноармейская|Утиная|Мая|Комсомольская|Муринский|Лахта|Верхний|_)
Пыталась сделать сама. Но именно эти задачки у меня не получились.
Подскажите, пожалуйста, как они решаются?


Код
Function street_extract_test()

'если слово в строке полностью из заглавных букв превратить его в "Первая Заглавная"
txt = "НОВЫЙ СВЕТ СоЛнЦе Луч9 20 САДОВОДСТВО дорога"
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "([А-ЯЁ]+{2,})"
regex.Global = True
'txt1 = regex.Replace(txt, Application.WorksheetFunction.Proper("$1"))

'Первая цифра в строке + первое перед этой цифрой слово с Заглавной буквы
txt = "2Санкт-Петербург, Обводный канал 45/1 строение 25Б Литер М"
regex.Global = False
regex.Pattern = "([\s|^]+)([А-Я]+)([А-Яа-я0-9A-Za-z\s]+)(\d+)(\s|$)?"
If regex.test(txt) Then
Set matches = regex.Execute(txt)
txt3 = matches.Item(0)
End If
End Function

Работать надо не 12 часов, а головой.
 
Leanna, вот вариант кода к первому вопросу:
Код
Sub cat1()
    Dim regex As RegExp, matches As IMatchCollection2, regMatch As IMatch2
    txt = "НОВЫЙ СВЕТ СоЛнЦе Луч9 20 САДОВОДСТВО дорога"
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = "([А-ЯЁ]{2,})"
        .Global = True
    End With
    Set matches = regex.Execute(txt)
    For Each regMatch In matches
        matchConverted = Left(regMatch.Value, 1) & LCase(Right(regMatch.Value, Len(regMatch.Value) - 1))
        txt = Left(txt, regMatch.FirstIndex) & Replace(txt, regMatch.Value, matchConverted, regMatch.FirstIndex + 1, -1, vbBinaryCompare)
    Next regMatch
End Sub


Ко второму:
Регулярка для вытягивания результата "Обводной канал": "([А-ЯЁ]+[А-яЁё ]+)\s*\d"
Регулярка для вытягивания результата "Обводной": "([А-ЯЁ]+[А-яЁё]+)[\sА-яЁё]*\d"

Код
Sub cat2()
    Dim regex As RegExp, matches As IMatchCollection2, regMatch As IMatch2
    txt = "2Санкт-Петербург, Обводный канал 45/1 строение 25Б Литер М"
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = "([А-ЯЁ]+[А-яЁё ]+)\s*\d"
        .Global = True
    End With
    Set matches = regex.Execute(txt)
    If matches.Count > 0 Then
        txtFound = Trim(matches(0).SubMatches(0))
        MsgBox txtFound
    End If
End Sub
Изменено: tolstak - 16.05.2018 17:11:36
In GoTo we trust
 
Цитата
Leanna написал:
Санкт-Петербург г. 8-я Красноармейская ул. 27
Offtop
Забавно. Яндекс карты и 2ГИС такого дома не находят, а вот Google - пожалуйста :)
 
вариант функции в B1 для #1( пример 3),для других вариантов аналогично,нужен файл-пример строчек 10
и вариант функций для #1( пример 2)

Код
 Function bbb$(t$)
     Dim pat$,O As Object
pat = "(?:Кадетская|Советская|Рабфаковский|Предпортовый|Января|Красноармейская|Утиная|Мая|Комсомольская|Муринский|Лахта|Верхний|_)"
With CreateObject("VBScript.RegExp"): .Pattern = "(" & "\d+" & ")" & ".+" & "(" & pat & ")" & ".+ул\. " & "(" & "\d+" & ")"
  Set O = .Execute(t)
 bbb = O(0).Submatches(0) & Chr(32) & O(0).Submatches(1) & Chr(32) & O(0).Submatches(2)
End With
End Function



 Function aaa$(t$)
     Dim pat$, O As Object:
With CreateObject("VBScript.RegExp"): .Pattern = " [А-ЯЁ][а-яё]+ [а-яё]+(?= \d)": Set O = .Execute(t)
 aaa = O(0)
End With
End Function

 Function vvv$(t$)
     Dim pat$, O As Object
With CreateObject("VBScript.RegExp"): .Pattern = "[А-ЯЁ][а-яё]+(?= [а-яё]+ \d+)": Set O = .Execute(t)
 vvv = O(0)
End With
End Function


Изменено: кузя1972 - 17.05.2018 16:54:48
 
Спасибо большое всем откликнувшимся!

Получилось далеко продвинуться по прототипу да аналогии сделала целую программку основанную на RegExp, которая очень помогает в работе.

По ходу возникали вопросы, но их надо систематизировать и уже разбираться с ними в новой теме.
Работать надо не 12 часов, а головой.
 
Может быть, будет полезно ознакомиться с этим ресурсом.
Владимир
Страницы: 1
Наверх