Здравствуйте, уважаемые форумчане. Прошу вашей помощи с написанием макроса. Есть список адресов. Надо проверить если строка начинается с цифры и в строке нет фрагмента "Российская Федерация", то заменить 7 позицию (после индекса и запятой) в строке на " Российская Федерация,". А если встречается "Россия" или "РФ", то заменить ее на "Российская Федерация" Если первое значение в строке не число, то окрасить ее в зеленый цвет.
Здравствуйте, уважаемые форумчане. Прошу вашей помощи с написанием макроса. Есть список адресов. Надо проверить если строка начинается с цифры и в строке нет фрагмента "Российская Федерация", то заменить 7 позицию (после индекса и запятой) в строке на " Российская Федерация,". А если встречается "Россия" или "РФ", то заменить ее на "Российская Федерация" Если первое значение в строке не число, то окрасить ее в зеленый цвет.EvaNa
Private Sub RF() Dim c As Range For Each c In Selection.Cells If IsNumeric(Left(c.Value, 3)) = False Then c.Interior.Color = vbGreen ElseIf InStr(1, c.Value, "Россия") > 0 Then c.Value = Replace(c.Value, "Россия", "Российская Федерация") ElseIf InStr(1, c.Value, " РФ") > 0 Then c.Value = Replace(c.Value, "РФ", "Российская Федерация") ElseIf InStr(1, c.Value, "Российская Федерация") = 0 Then c.Value = Left(c.Value, 7) & " Российская Федерация, " & Right(c.Value, Len(c.Value) - 8) End If Next End Sub
[/vba]
К выделенному диапазону:
[vba]
Код
Private Sub RF() Dim c As Range For Each c In Selection.Cells If IsNumeric(Left(c.Value, 3)) = False Then c.Interior.Color = vbGreen ElseIf InStr(1, c.Value, "Россия") > 0 Then c.Value = Replace(c.Value, "Россия", "Российская Федерация") ElseIf InStr(1, c.Value, " РФ") > 0 Then c.Value = Replace(c.Value, "РФ", "Российская Федерация") ElseIf InStr(1, c.Value, "Российская Федерация") = 0 Then c.Value = Left(c.Value, 7) & " Российская Федерация, " & Right(c.Value, Len(c.Value) - 8) End If Next End Sub
Function iРФ(cell$) As String With CreateObject("VBScript.RegExp") .IgnoreCase = True .Pattern = "[^,](РФ|Россия|Российская Федерация)" If .test(cell) Then iРФ = .Replace(cell, " Российская Федерация") Else If IsNumeric(Left(cell, 6)) Then iРФ = Left(cell, 6) & ", Российская Федерация" & Mid(cell, 7) Else iРФ = "Нет почтового индекса" End If End If End With End Function
[/vba]
UDF [vba]
Код
Function iРФ(cell$) As String With CreateObject("VBScript.RegExp") .IgnoreCase = True .Pattern = "[^,](РФ|Россия|Российская Федерация)" If .test(cell) Then iРФ = .Replace(cell, " Российская Федерация") Else If IsNumeric(Left(cell, 6)) Then iРФ = Left(cell, 6) & ", Российская Федерация" & Mid(cell, 7) Else iРФ = "Нет почтового индекса" End If End If End With End Function
Kuzmich, Спасибо и вам за решение. У меня будет несколько макросов для обработки текстовых данных и все они собраны в основной книге. Для работы с данными в других книга буду подтягивать макросы из основной. И вот насколько понимаю макросы из открытой основной книги подтянуть никакого труда, а вот функцию надо прописывать в каждой новой книге, или прописывать макрос ссылающийся на модуль с функцией в основном листе. Пока мне известен только такой вариант, но многого еще не знаю.
Kuzmich, Спасибо и вам за решение. У меня будет несколько макросов для обработки текстовых данных и все они собраны в основной книге. Для работы с данными в других книга буду подтягивать макросы из основной. И вот насколько понимаю макросы из открытой основной книги подтянуть никакого труда, а вот функцию надо прописывать в каждой новой книге, или прописывать макрос ссылающийся на модуль с функцией в основном листе. Пока мне известен только такой вариант, но многого еще не знаю.EvaNa
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
