Здравствуйте! Уважаемые знатоки, помогите пожалуйста решить задачку, если она вообще решаема. В ячейки текст из нескольких предложений, среди предложений попадается ФИО в виде ААААА А.А. нужен макрос или формула для изменения регистра ФИО в вид Ааааа А.А.
Здравствуйте! Уважаемые знатоки, помогите пожалуйста решить задачку, если она вообще решаема. В ячейки текст из нескольких предложений, среди предложений попадается ФИО в виде ААААА А.А. нужен макрос или формула для изменения регистра ФИО в вид Ааааа А.А.doberman
doberman, здравствуйте, посмотрите такой вариант: [vba]
Код
Function fio(txt) Dim tmp, spl, m With CreateObject("VBScript.RegExp") .Global = True: .ignoreCase = False .Pattern = "([А-ЯЁ]+\s[А-ЯЁ]\.[А-ЯЁ]\.)" Set tmp = .Execute(txt) For Each m In tmp spl = Split(m, " ") txt = Replace(txt, m, StrConv(spl(0), 3) & " " & spl(1)) Next m fio = txt End With End Function
[/vba]
doberman, здравствуйте, посмотрите такой вариант: [vba]
Код
Function fio(txt) Dim tmp, spl, m With CreateObject("VBScript.RegExp") .Global = True: .ignoreCase = False .Pattern = "([А-ЯЁ]+\s[А-ЯЁ]\.[А-ЯЁ]\.)" Set tmp = .Execute(txt) For Each m In tmp spl = Split(m, " ") txt = Replace(txt, m, StrConv(spl(0), 3) & " " & spl(1)) Next m fio = txt End With End Function
Предполагается, что данные начинаются со строки 1 (то есть нет шапки таблицы). В приложенном файле макроса нет. Файл я выложил, чтобы показать для какого листа написан макрос.
[vba]
Код
Sub Заменить_регистр()
Dim arr(), var, lr As Long Dim i As Long, ii As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row arr() = Range("A1:A" & lr).Value
For i = 1 To UBound(arr) var = Split(arr(i, 1), " ") For ii = 0 To UBound(var) - 1 If var(ii) = UCase(var(ii)) Then If var(ii + 1) Like "[А-ЯЁA-Z].[А-ЯЁA-Z]." Then var(ii) = StrConv(var(ii), vbProperCase) End If End If Next ii arr(i, 1) = Join(var, " ") Next i
Предполагается, что данные начинаются со строки 1 (то есть нет шапки таблицы). В приложенном файле макроса нет. Файл я выложил, чтобы показать для какого листа написан макрос.
[vba]
Код
Sub Заменить_регистр()
Dim arr(), var, lr As Long Dim i As Long, ii As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row arr() = Range("A1:A" & lr).Value
For i = 1 To UBound(arr) var = Split(arr(i, 1), " ") For ii = 0 To UBound(var) - 1 If var(ii) = UCase(var(ii)) Then If var(ii + 1) Like "[А-ЯЁA-Z].[А-ЯЁA-Z]." Then var(ii) = StrConv(var(ii), vbProperCase) End If End If Next ii arr(i, 1) = Join(var, " ") Next i
Manyasha, Можите пожалуйста подправить следующее. В тексте иногда попадаются кавычки в них одно или два слова в верхнем регисре т.е. так «СЛОВО» необходимо убрать кавычки и привести к нижнему регистру т.е. получить слово
Manyasha, Можите пожалуйста подправить следующее. В тексте иногда попадаются кавычки в них одно или два слова в верхнем регисре т.е. так «СЛОВО» необходимо убрать кавычки и привести к нижнему регистру т.е. получить словоdoberman
Function bbb$(t$) Dim i& With CreateObject("VBScript.RegExp"): .Pattern = "[А-ЯЁ]+ [А-ЯЁ]\.[А-ЯЁ]\.": .Global = True For i = 0 To .Execute(t).Count - 1: bbb = .Replace(t, Application.Proper(.Execute(t)(i))): Next End With End Function
[/vba]
doberman, еще вариант функции в A2
[vba]
Код
Function bbb$(t$) Dim i& With CreateObject("VBScript.RegExp"): .Pattern = "[А-ЯЁ]+ [А-ЯЁ]\.[А-ЯЁ]\.": .Global = True For i = 0 To .Execute(t).Count - 1: bbb = .Replace(t, Application.Proper(.Execute(t)(i))): Next End With End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
