Добрый день! Прошу вашей помощи с созданием макроса. У меня есть список адресов, где по разному записаны улицы. Пример для понимания: РФ, Омская область, г. Омск, Диановая ул, д. 16 Можно ли в макросе описать следующую задачу? Найти в строке текст " ул," и если он есть, то его удалить, а на место предыдущего в тексте пробела (от того, где найден искомый текст) вставить " ул. " Т.е. Результат должен быть: РФ, Омская область, г. Омск, ул. Диановая, д. 16
Добрый день! Прошу вашей помощи с созданием макроса. У меня есть список адресов, где по разному записаны улицы. Пример для понимания: РФ, Омская область, г. Омск, Диановая ул, д. 16 Можно ли в макросе описать следующую задачу? Найти в строке текст " ул," и если он есть, то его удалить, а на место предыдущего в тексте пробела (от того, где найден искомый текст) вставить " ул. " Т.е. Результат должен быть: РФ, Омская область, г. Омск, ул. Диановая, д. 16EvaNa
Sub u_1148() Application.ScreenUpdating = False a = Cells(Rows.Count, "a").End(xlUp).Row For Each b In Range("a1:a" & a) c = InStr(b, "ул,") If c > 0 Then d = Left(b, c) e = InStrRev(d, ",") f = Left(b, e) & " ул." g = Len(b) h = Right(b, g - e) i = f & h b.Value = Replace(i, " ул,", ",") End If Next Application.ScreenUpdating = True End Sub
[/vba]
как-то так наверное [vba]
Код
Sub u_1148() Application.ScreenUpdating = False a = Cells(Rows.Count, "a").End(xlUp).Row For Each b In Range("a1:a" & a) c = InStr(b, "ул,") If c > 0 Then d = Left(b, c) e = InStrRev(d, ",") f = Left(b, e) & " ул." g = Len(b) h = Right(b, g - e) i = f & h b.Value = Replace(i, " ул,", ",") End If Next Application.ScreenUpdating = True End Sub
Function iStreet(cell$) As String With CreateObject("VBScript.RegExp") .IgnoreCase = True .Pattern = "[^,]([А-ЯЁ ]+) (ул)" iStreet = .Replace(cell, "$2. $1") End With End Function
[/vba]
UDF [vba]
Код
Function iStreet(cell$) As String With CreateObject("VBScript.RegExp") .IgnoreCase = True .Pattern = "[^,]([А-ЯЁ ]+) (ул)" iStreet = .Replace(cell, "$2. $1") End With End Function