Задача явно не из повседневных :-) Допустим, имеется база адресов примерно такого вида:
Требуется: поменять объекты адреса местами полностью. Т.е. изначальный порядок объектов такой: Индекс; Область; Район; Населенный пункт; Улица; Дом, а необходимо его сделать обратным: Дом; Улица; Населенный пункт; Район; Область; Индекс.
В принципе не так и сложно на первый взгляд. Можно применить команду "Текст по столбцам" и собрать в обратном порядке. Но. Где-то может не оказаться индекса, где-то населенный пункт из двух слов("Красная заря"), в каких населенных пунктах отсутствует улица. Каша получится неплохая и выбирать руками пару тысяч таких косяков будет занятием не из самых интересных.
Стало довольно интересно лишний раз попрактиковаться над конструкциями регулярных выражений и составил функцию, котороя переворачивает адрес:
'--------------------------------------------------------------------------------------- ' 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 |
Синтаксис функции:
sAddress - адрес в виде текста или ссылка на ячейку.
На самом деле функцию можно использовать не для переворота адреса, а просто для разбиения адреса на составные части. К примеру для адреса "143622 Московская обл Волоколамский район с.Рюховское ул.Полевая д.6" функция возвращает список отдельных значений:
- д.6
- ул.Полевая
- с.Рюховское
- Волоколамский район
- Московская обл
- 143622
А уже цикл (For li = objMatches.Count To 1 Step -1) объединяет в одну строку. Так что при желании можно использовать функцию как-то иначе.
Tips_Macro_ReverseAddress.xls (45,5 КиБ, 1 320 скачиваний)
Следует учитывать, что данная функция будет работать не с любыми адресами. Функция написана под более-менее конкретную задачу и вполне может получиться так, что для другой задачи она окажется совершенно бессильна и результат будет некорректным.
Так же см.:
Как перевернуть слово?
Функция перемещения слова в строке
Подскажите пож., каким образом можно сделать наоборот? Изначально адрес в перевернутом значении находится, необходимо вернуть его в правильный порядок: индекс, Регион, район (если есть), город, ул. номер дома и номер квартиры, сейчас адресы указаны следующим образом: "416506, д.Жуковского ул д. 26, кв.кв.30, Ахтубинск г,, Ахтубинский р-н, Астраханская обл"