Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Изменение регистра части текста в ячейке - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение регистра части текста в ячейке (Макросы/Sub)
Изменение регистра части текста в ячейке
shinkai Дата: Четверг, 07.04.2016, 08:15 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Проблема в следующем: надо изменить регистр только части текста в ячейках - а именно ту часть, что написана по-русски. Все файлы (а их несколько тысяч) составлены нашими заокеанскими партнерами на двух языках, причем коряво - во многих ячейках встречаются сразу оба языка и все написано заглавными буквами. Возникла жизненная необходимость заменить русские заглавные на русские строчные (как в предложении), за некоторым исключением в виде аббревиатур. Все макросы, что встречались мне ранее, действуют по замене всей информации в ячейке. Возникла мысль применить функцию CODE для поиска русского алфавита в ячейке и затем уже применить конвертацию. Но никак не соображу, как это прописать. И как в этом случае прописать исключения для аббревиатур?
[p.s.]не спец по макросам, задача свалилась в силу непреодолимых обстоятельств, посему буду благодарен за подсказки.
К сообщению приложен файл: Example.xls(58Kb)
 
Ответить
СообщениеПроблема в следующем: надо изменить регистр только части текста в ячейках - а именно ту часть, что написана по-русски. Все файлы (а их несколько тысяч) составлены нашими заокеанскими партнерами на двух языках, причем коряво - во многих ячейках встречаются сразу оба языка и все написано заглавными буквами. Возникла жизненная необходимость заменить русские заглавные на русские строчные (как в предложении), за некоторым исключением в виде аббревиатур. Все макросы, что встречались мне ранее, действуют по замене всей информации в ячейке. Возникла мысль применить функцию CODE для поиска русского алфавита в ячейке и затем уже применить конвертацию. Но никак не соображу, как это прописать. И как в этом случае прописать исключения для аббревиатур?
[p.s.]не спец по макросам, задача свалилась в силу непреодолимых обстоятельств, посему буду благодарен за подсказки.

Автор - shinkai
Дата добавления - 07.04.2016 в 08:15
zopa Дата: Четверг, 07.04.2016, 08:54 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 100% ±

Excel 2010
RegExp в помощь. Пример во вложении.
К сообщению приложен файл: 3865740.xlsm(36Kb)


Сообщение отредактировал zopa - Четверг, 07.04.2016, 09:30
 
Ответить
СообщениеRegExp в помощь. Пример во вложении.

Автор - zopa
Дата добавления - 07.04.2016 в 08:54
KuklP Дата: Четверг, 07.04.2016, 09:13 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

[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]
К сообщению приложен файл: _Example-1.xls(87Kb)


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение[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]

Автор - KuklP
Дата добавления - 07.04.2016 в 09:13
shinkai Дата: Четверг, 07.04.2016, 10:21 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Пример во вложении.

Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.

Цитата KuklP
Function RUS
что-то не работает...
 
Ответить
Сообщение
Пример во вложении.

Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.

Цитата KuklP
Function RUS
что-то не работает...

Автор - shinkai
Дата добавления - 07.04.2016 в 10:21
zopa Дата: Четверг, 07.04.2016, 10:25 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 100% ±

Excel 2010
Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.

"[А-Я-Ё]"
[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]


Сообщение отредактировал zopa - Четверг, 07.04.2016, 10:33
 
Ответить
Сообщение
Спасибо, но немного не то. Не могли бы вы написать здесь, какую маску вы установили, а то у меня японский софт, какая-то абракадабра отображается. Полагаю, что там указан класс [А-Я], но кажется там еще что-то, не идентифицирую что именно.

"[А-Я-Ё]"
[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]

Автор - zopa
Дата добавления - 07.04.2016 в 10:25
shinkai Дата: Четверг, 07.04.2016, 10:30 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010

Спасибо!
 
Ответить
Сообщение
Спасибо!

Автор - shinkai
Дата добавления - 07.04.2016 в 10:30
KuklP Дата: Четверг, 07.04.2016, 12:25 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

что-то не работает...
Скачал свой файл, ткнул кнопку, см. результат.
К сообщению приложен файл: 5723722.gif(44Kb)


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение
что-то не работает...
Скачал свой файл, ткнул кнопку, см. результат.

Автор - KuklP
Дата добавления - 07.04.2016 в 12:25
shinkai Дата: Пятница, 08.04.2016, 03:01 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Скачал свой файл, ткнул кнопку, см. результат

Я наверно что-то не то делаю, но у меня и правда не запускается...
 
Ответить
Сообщение
Скачал свой файл, ткнул кнопку, см. результат

Я наверно что-то не то делаю, но у меня и правда не запускается...

Автор - shinkai
Дата добавления - 08.04.2016 в 03:01
StoTisteg Дата: Суббота, 09.04.2016, 00:40 | Сообщение № 9
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010

А должно быть "[А-Я,Ё]"...


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
А должно быть "[А-Я,Ё]"...

Автор - StoTisteg
Дата добавления - 09.04.2016 в 00:40
МВТ Дата: Суббота, 09.04.2016, 06:21 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 475
Репутация: 136 ±
Замечаний: 0% ±

Excel 2007
А должно быть "[А-Я,Ё]"...

Если точнее, то "[А-ЯЁ]"
 
Ответить
Сообщение
А должно быть "[А-Я,Ё]"...

Если точнее, то "[А-ЯЁ]"

Автор - МВТ
Дата добавления - 09.04.2016 в 06:21
StoTisteg Дата: Суббота, 09.04.2016, 14:19 | Сообщение № 11
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Это уже зависит от диалекта регэкспов. В какнонiчном — с запятой.


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеЭто уже зависит от диалекта регэкспов. В какнонiчном — с запятой.

Автор - StoTisteg
Дата добавления - 09.04.2016 в 14:19
krosav4ig Дата: Понедельник, 11.04.2016, 17:16 | Сообщение № 12
Группа: Друзья
Ранг: Старожил
Сообщений: 1349
Репутация: 547 ±
Замечаний: 0% ±

Excel 2007, 2013
чего-то в голову ударило, написал еще вот такой изврат :D
[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]
К сообщению приложен файл: 8010588.xls(68Kb)


(_)Õvõ(_)
 
Ответить
Сообщениечего-то в голову ударило, написал еще вот такой изврат :D
[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]

Автор - krosav4ig
Дата добавления - 11.04.2016 в 17:16
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение регистра части текста в ячейке (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!