Хитрости »

Как перевернуть адрес

 

Задача явно не из повседневных :-) Допустим, имеется база адресов примерно такого вида:
Исходные данные
Требуется: поменять объекты адреса местами полностью. Т.е. изначальный порядок объектов такой: Индекс; Область; Район; Населенный пункт; Улица; Дом, а необходимо его сделать обратным: Дом; Улица; Населенный пункт; Район; Область; Индекс.
Результат
В принципе не так и сложно на первый взгляд. Можно применить команду "Текст по столбцам" и собрать в обратном порядке. Но. Где-то может не оказаться индекса, где-то населенный пункт из двух слов("Красная заря"), в каких населенных пунктах отсутствует улица. Каша получится неплохая и выбирать руками пару тысяч таких косяков будет занятием не из самых интересных.
Стало довольно интересно лишний раз попрактиковаться над конструкциями регулярных выражений и составил функцию, котороя переворачивает адрес:

'---------------------------------------------------------------------------------------
' Procedure : ReverseAddr
' DateTime  : 04.09.2013 10:28
' Author    : The_Prist(Щербаков Дмитрий)
'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
'             http://www.excel-vba.ru
' Purpose   : Функция меняет местами адрес.
'             Могут встречаться такие сокращения как:
'             "обл", так и "область", и "об-ть"; "район", "ра-н", "р-он", "р-н"
'             Они будут обработаны корректно.
'             Для наименований населенных пунктов обязательно наличие точки на конце
'             и не более 3-х букв обозначения нас.пункта: "пос.","дер.","с.","г.".
'             После точки допускается наличие пробела.
'---------------------------------------------------------------------------------------
Dim objRegExp As Object
 
Function ReverseAddr(sAddress As String)
    Dim objMatches As Object, sRes As String, li As Long
 
    If objRegExp Is Nothing Then
        Set objRegExp = CreateObject("VBScript.RegExp")
        With objRegExp
            .Global = True: .MultiLine = True: .ignorecase = True
            .Pattern = "(\d{6})|" & _
                       "(\D{1,} ((об(л?-?а?с?т?ь?)|край))|" & _
                       "\D{1,} р([айо\-]{1,3})?н)|" & _
                       "\D{1,3}\. ?([а-яё]{1,}( [а-яё]{1,}[^д.ул.])?)|" & _
                       "д\. ?\d{1,4}(\D)?"
        End With
    End If
    Set objMatches = objRegExp.Execute(Application.Trim(sAddress))
    If objMatches.Count > 0 Then
        For li = objMatches.Count To 1 Step -1
            If Trim(objMatches.Item(li - 1).Value) <> "" Then
                sRes = sRes & " " & objMatches.Item(li - 1).Value
            End If
        Next li
    End If
    ReverseAddr = Mid(sRes, 2)
End Function

Синтаксис функции:
=ReverseAddr(A2)
sAddress - адрес в виде текста или ссылка на ячейку.

На самом деле функцию можно использовать не для переворота адреса, а просто для разбиения адреса на составные части. К примеру для адреса "143622 Московская обл Волоколамский район с.Рюховское ул.Полевая д.6" функция возвращает список отдельных значений:

  • д.6
  • ул.Полевая
  • с.Рюховское
  • Волоколамский район
  • Московская обл
  • 143622

А уже цикл (For li = objMatches.Count To 1 Step -1) объединяет в одну строку. Так что при желании можно использовать функцию как-то иначе.

Следует учитывать, что данная функция будет работать не с любыми адресами. Функция написана под более-менее конкретную задачу и вполне может получиться так, что для другой задачи она окажется совершенно бессильна и результат будет некорректным.

Так же см.:
[[Как перевернуть слово?]]

Скачать

  Tips_Macro_ReverseAddress.xls (45,5 KiB, 829 скачиваний)


Статья помогла? Сделай твит, поделись ссылкой с друзьями!
Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти