Проблема в следующем: надо изменить регистр только части текста в ячейках - а именно ту часть, что написана по-русски. Все файлы (а их несколько тысяч) составлены нашими заокеанскими партнерами на двух языках, причем коряво - во многих ячейках встречаются сразу оба языка и все написано заглавными буквами. Возникла жизненная необходимость заменить русские заглавные на русские строчные (как в предложении), за некоторым исключением в виде аббревиатур. Все макросы, что встречались мне ранее, действуют по замене всей информации в ячейке. Возникла мысль применить функцию CODE для поиска русского алфавита в ячейке и затем уже применить конвертацию. Но никак не соображу, как это прописать. И как в этом случае прописать исключения для аббревиатур? [p.s.]не спец по макросам, задача свалилась в силу непреодолимых обстоятельств, посему буду благодарен за подсказки.
Проблема в следующем: надо изменить регистр только части текста в ячейках - а именно ту часть, что написана по-русски. Все файлы (а их несколько тысяч) составлены нашими заокеанскими партнерами на двух языках, причем коряво - во многих ячейках встречаются сразу оба языка и все написано заглавными буквами. Возникла жизненная необходимость заменить русские заглавные на русские строчные (как в предложении), за некоторым исключением в виде аббревиатур. Все макросы, что встречались мне ранее, действуют по замене всей информации в ячейке. Возникла мысль применить функцию CODE для поиска русского алфавита в ячейке и затем уже применить конвертацию. Но никак не соображу, как это прописать. И как в этом случае прописать исключения для аббревиатур? [p.s.]не спец по макросам, задача свалилась в силу непреодолимых обстоятельств, посему буду благодарен за подсказки.shinkai
Function RUS(s$) As String Dim i%, ascii%, tmp$ For i = 1 To Len(s) ascii = Asc(Mid(s, i, 1)) If (ascii >= 192 And ascii <= 255 Or ascii = 32) Then _ tmp = tmp & LCase(Mid(s, i, 1)) Else _ tmp = tmp & Mid(s, i, 1) Next i RUS = Trim(tmp) End Function
Public Sub www() Dim c As Range For Each c In ActiveSheet.UsedRange.SpecialCells(2).Cells c = RUS(c.Value) Next End Sub
[/vba]
[vba]
Код
Function RUS(s$) As String Dim i%, ascii%, tmp$ For i = 1 To Len(s) ascii = Asc(Mid(s, i, 1)) If (ascii >= 192 And ascii <= 255 Or ascii = 32) Then _ tmp = tmp & LCase(Mid(s, i, 1)) Else _ tmp = tmp & Mid(s, i, 1) Next i RUS = Trim(tmp) End Function
Public Sub www() Dim c As Range For Each c In ActiveSheet.UsedRange.SpecialCells(2).Cells c = RUS(c.Value) Next End Sub
Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.
Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.
Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.
"[А-Я-Ё]" [vba]
Код
Public Function Lol(astring) As String Set re = CreateObject("VBScript.RegExp") re.Pattern = "[А-Я-Ё]" re.Global = True re.IgnoreCase = False Set Matches = re.Execute(astring) For Each symbol In Matches astring = Replace(astring, symbol, LCase(symbol)) Next symbol Lol = astring End Function
Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.
"[А-Я-Ё]" [vba]
Код
Public Function Lol(astring) As String Set re = CreateObject("VBScript.RegExp") re.Pattern = "[А-Я-Ё]" re.Global = True re.IgnoreCase = False Set Matches = re.Execute(astring) For Each symbol In Matches astring = Replace(astring, symbol, LCase(symbol)) Next symbol Lol = astring End Function
чего-то в голову ударило, написал еще вот такой изврат [vba]
Код
Public Sub rr() Dim arr(), i& With CreateObject("ScriptControl") .Language = "JScript" .AddCode "function a(b){return b.replace(/[А-ЯЁ]/gm,function(c){return c.toLowerCase()})}" arr = Selection.Value For i = LBound(arr) To UBound(arr) If Len(arr(i, 1)) Then arr(i, 1) = .Run("a", arr(i, 1)) Next Selection.Value = arr End With End Sub
[/vba]
чего-то в голову ударило, написал еще вот такой изврат [vba]
Код
Public Sub rr() Dim arr(), i& With CreateObject("ScriptControl") .Language = "JScript" .AddCode "function a(b){return b.replace(/[А-ЯЁ]/gm,function(c){return c.toLowerCase()})}" arr = Selection.Value For i = LBound(arr) To UBound(arr) If Len(arr(i, 1)) Then arr(i, 1) = .Run("a", arr(i, 1)) Next Selection.Value = arr End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
