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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос "Color_RUS_LAT" - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Готовые решения » Макрос "Color_RUS_LAT" (Выделяет РУС-символы в Selection ЗЕЛЁНЫМ, а LAT - КРАСНЫМ)
Макрос "Color_RUS_LAT"
Alex_ST Дата: Суббота, 29.01.2011, 22:49 | Сообщение № 1
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
Для обработки-сведения в общую учётную таблицу плодов трудов "умельцев", которые мешают в тексте латиницу и кириллицу, написал макрос, выделяющий такие буквы разным цветом:
[vba]
Code
Sub Color_RUS_LAT()   ' Выделяет русские символы в Selection ЗЕЛЁНЫМ, латинские - КРАСНЫМ
        If TypeName(Selection) <> "Range" Then Exit Sub
        Dim iCell As Range, rRange As Range, i%, ASCII%, iColor%
        On Error GoTo eXXit
        Set rRange = Intersect(Selection, ActiveSheet.UsedRange)
        If rRange Is Nothing Then Exit Sub
        Application.ScreenUpdating = False
        For Each iCell In rRange
            For i = 1 To Len(iCell)
                ASCII = Asc(Mid(iCell, i, 1))
                If (ASCII >= 192 And ASCII <= 255) Then iColor = 10   'цвет символов РУС
                If (ASCII >= 65 And ASCII <= 90) Or (ASCII >= 97 And ASCII <= 122) Then iColor = 3   'цвет символов LAT
                iCell.Characters(Start:=i, Length:=1).Font.ColorIndex = iColor
            Next i
        Next iCell
        rRange.Select
        Application.ScreenUpdating = True
eXXit:     End Sub
[/vba]
Этот макрос я у себя в Personal.xls положил, а пункт-кнопочку для его вызова в меню "Сервис" засунул с капчей "Выделить цветом РУС-LAT" и регулярно пользуюсь. Здорово помогает.



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Суббота, 29.01.2011, 22:50
 
Ответить
СообщениеДля обработки-сведения в общую учётную таблицу плодов трудов "умельцев", которые мешают в тексте латиницу и кириллицу, написал макрос, выделяющий такие буквы разным цветом:
[vba]
Code
Sub Color_RUS_LAT()   ' Выделяет русские символы в Selection ЗЕЛЁНЫМ, латинские - КРАСНЫМ
        If TypeName(Selection) <> "Range" Then Exit Sub
        Dim iCell As Range, rRange As Range, i%, ASCII%, iColor%
        On Error GoTo eXXit
        Set rRange = Intersect(Selection, ActiveSheet.UsedRange)
        If rRange Is Nothing Then Exit Sub
        Application.ScreenUpdating = False
        For Each iCell In rRange
            For i = 1 To Len(iCell)
                ASCII = Asc(Mid(iCell, i, 1))
                If (ASCII >= 192 And ASCII <= 255) Then iColor = 10   'цвет символов РУС
                If (ASCII >= 65 And ASCII <= 90) Or (ASCII >= 97 And ASCII <= 122) Then iColor = 3   'цвет символов LAT
                iCell.Characters(Start:=i, Length:=1).Font.ColorIndex = iColor
            Next i
        Next iCell
        rRange.Select
        Application.ScreenUpdating = True
eXXit:     End Sub
[/vba]
Этот макрос я у себя в Personal.xls положил, а пункт-кнопочку для его вызова в меню "Сервис" засунул с капчей "Выделить цветом РУС-LAT" и регулярно пользуюсь. Здорово помогает.

Автор - Alex_ST
Дата добавления - 29.01.2011 в 22:49
Гость Дата: Среда, 11.07.2012, 10:53 | Сообщение № 2
Группа: Гости
пригодился. Спасибо!
 
Ответить
Сообщениепригодился. Спасибо!

Автор - Гость
Дата добавления - 11.07.2012 в 10:53
Alex_ST Дата: Среда, 11.07.2012, 12:28 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
Совсем забыл про этот свой пост.
А ведь вносил коррекцию: забыл про русские ё и Ё, коды которых размещены в таблице символов отдельно.
Вот так будет точнее:
[vba]
Code
Private Sub Color_RUS_LAT()   ' Выделяет русские символы в Selection ЗЕЛЁНЫМ, латинские - КРАСНЫМ
    If TypeName(Selection) <> "Range" Then Exit Sub
    If Intersect(Selection, ActiveSheet.UsedRange) Is Nothing Then Exit Sub
    Dim rCell As Range, i%, ASCII%, iColor%
    Application.ScreenUpdating = False
    For Each rCell In Intersect(Selection, ActiveSheet.UsedRange)
       For i = 1 To Len(rCell)
          ASCII = Asc(Mid(rCell, i, 1))
          If (ASCII >= 192 And ASCII <= 255) Or ASCII = 168 Or ASCII = 184 Then iColor = 10   'цвет символов РУС
          If (ASCII >= 65 And ASCII <= 90) Or (ASCII >= 97 And ASCII <= 122) Then iColor = 3   'цвет символов LAT
          rCell.Characters(Start:=i, Length:=1).Font.ColorIndex = iColor
       Next i
    Next rCell
    Application.ScreenUpdating = True
    Intersect(Selection, ActiveSheet.UsedRange).Select
End Sub
[/vba]



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Среда, 11.07.2012, 12:29
 
Ответить
СообщениеСовсем забыл про этот свой пост.
А ведь вносил коррекцию: забыл про русские ё и Ё, коды которых размещены в таблице символов отдельно.
Вот так будет точнее:
[vba]
Code
Private Sub Color_RUS_LAT()   ' Выделяет русские символы в Selection ЗЕЛЁНЫМ, латинские - КРАСНЫМ
    If TypeName(Selection) <> "Range" Then Exit Sub
    If Intersect(Selection, ActiveSheet.UsedRange) Is Nothing Then Exit Sub
    Dim rCell As Range, i%, ASCII%, iColor%
    Application.ScreenUpdating = False
    For Each rCell In Intersect(Selection, ActiveSheet.UsedRange)
       For i = 1 To Len(rCell)
          ASCII = Asc(Mid(rCell, i, 1))
          If (ASCII >= 192 And ASCII <= 255) Or ASCII = 168 Or ASCII = 184 Then iColor = 10   'цвет символов РУС
          If (ASCII >= 65 And ASCII <= 90) Or (ASCII >= 97 And ASCII <= 122) Then iColor = 3   'цвет символов LAT
          rCell.Characters(Start:=i, Length:=1).Font.ColorIndex = iColor
       Next i
    Next rCell
    Application.ScreenUpdating = True
    Intersect(Selection, ActiveSheet.UsedRange).Select
End Sub
[/vba]

Автор - Alex_ST
Дата добавления - 11.07.2012 в 12:28
ikki Дата: Среда, 28.11.2012, 17:00 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
приведенные макросы всем хороши, одна беда - на больших объемах работают не слишком шустро.
у меня аналогичный макрос на 52000+ ячеек работал более 100 сек. (точнее - 102,3) на не слишком старой машине.
на первый взгляд мне казалось, что ничего глобально тут не ускоришь - цвета символов в массив быстро не заберешь и из массива на лист одной командой не выгрузишь.

но после некоторого (я понимаю - пока поверхностного) изучения RegExp'ов у меня появился такой вариант макроса, выполняющего ту же работу:

[vba]
Code
' Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub myColorRusLat()
       Dim tt&, i%, c As Range, rLat As Object, rRus As Object, x As Object
       Dim r As Range, a(), i1%, i2%, s$
'  tt = GetTickCount
       Set rLat = CreateObject("vbscript.regexp")
       With rLat
           .ignorecase = True
           .Global = True
           .Pattern = "[a-z]+"
       End With
       Set rRus = CreateObject("vbscript.regexp")
       With rRus
           .ignorecase = True
           .Global = True
           .Pattern = "[а-яё]+"
       End With
        
       Set r = Selection: a = r.Value
       For i1 = 1 To UBound(a, 1)
           For i2 = 1 To UBound(a, 2)
               If Not IsEmpty(a(i1, i2)) Then
                   s = CStr(a(i1, i2))
                   Set x = rLat.Execute(s)
                   For i = 0 To x.Count - 1
                       r(i1, i2).Characters(Start:=x(i).firstindex + 1, Length:=x(i).Length).Font.ColorIndex = 3
                   Next
                   Set x = rRus.Execute(s)
                   For i = 0 To x.Count - 1
                       r(i1, i2).Characters(Start:=x(i).firstindex + 1, Length:=x(i).Length).Font.ColorIndex = 10
                   Next
               End If
           Next
       Next
        
       Erase a: Set rLat = Nothing: Set rRus = Nothing: Set x = Nothing
'   Debug.Print GetTickCount - tt
End Sub
[/vba]

закомментированные строки нужны только для теста времени.
в отличие от макросов Alex_ST, этот вариант написан только для связного выделенного диапазона.
недостатки очевидны, но и достоинства есть: текст из ячеек можно забрать в массив, поэтому работает немного быстрее.
если нужно - переделать на несвязный диапазон недолго, да и код будет немного короче, но и работать будет немного медленнее.

но моих данных этот макрос отработал за 41,8 сек. (быстрее в 2,4 раза).
думаю, разница во времени может отличаться в зависимости от того, насколько сильно "перемешаны" русские и латинские символы внутри строк, насколько длинные сами строки и т.п...

но, как вариант - можно использовать, имхо.


помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki


Сообщение отредактировал ikki - Среда, 28.11.2012, 17:07
 
Ответить
Сообщениеприведенные макросы всем хороши, одна беда - на больших объемах работают не слишком шустро.
у меня аналогичный макрос на 52000+ ячеек работал более 100 сек. (точнее - 102,3) на не слишком старой машине.
на первый взгляд мне казалось, что ничего глобально тут не ускоришь - цвета символов в массив быстро не заберешь и из массива на лист одной командой не выгрузишь.

но после некоторого (я понимаю - пока поверхностного) изучения RegExp'ов у меня появился такой вариант макроса, выполняющего ту же работу:

[vba]
Code
' Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub myColorRusLat()
       Dim tt&, i%, c As Range, rLat As Object, rRus As Object, x As Object
       Dim r As Range, a(), i1%, i2%, s$
'  tt = GetTickCount
       Set rLat = CreateObject("vbscript.regexp")
       With rLat
           .ignorecase = True
           .Global = True
           .Pattern = "[a-z]+"
       End With
       Set rRus = CreateObject("vbscript.regexp")
       With rRus
           .ignorecase = True
           .Global = True
           .Pattern = "[а-яё]+"
       End With
        
       Set r = Selection: a = r.Value
       For i1 = 1 To UBound(a, 1)
           For i2 = 1 To UBound(a, 2)
               If Not IsEmpty(a(i1, i2)) Then
                   s = CStr(a(i1, i2))
                   Set x = rLat.Execute(s)
                   For i = 0 To x.Count - 1
                       r(i1, i2).Characters(Start:=x(i).firstindex + 1, Length:=x(i).Length).Font.ColorIndex = 3
                   Next
                   Set x = rRus.Execute(s)
                   For i = 0 To x.Count - 1
                       r(i1, i2).Characters(Start:=x(i).firstindex + 1, Length:=x(i).Length).Font.ColorIndex = 10
                   Next
               End If
           Next
       Next
        
       Erase a: Set rLat = Nothing: Set rRus = Nothing: Set x = Nothing
'   Debug.Print GetTickCount - tt
End Sub
[/vba]

закомментированные строки нужны только для теста времени.
в отличие от макросов Alex_ST, этот вариант написан только для связного выделенного диапазона.
недостатки очевидны, но и достоинства есть: текст из ячеек можно забрать в массив, поэтому работает немного быстрее.
если нужно - переделать на несвязный диапазон недолго, да и код будет немного короче, но и работать будет немного медленнее.

но моих данных этот макрос отработал за 41,8 сек. (быстрее в 2,4 раза).
думаю, разница во времени может отличаться в зависимости от того, насколько сильно "перемешаны" русские и латинские символы внутри строк, насколько длинные сами строки и т.п...

но, как вариант - можно использовать, имхо.

Автор - ikki
Дата добавления - 28.11.2012 в 17:00
Alex_ST Дата: Среда, 28.11.2012, 21:40 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
Саш, интересный, конечно, вариант.
Но мне, к счастью, огромных массивов данных обрабатывать не надо. Поэтому твой вариант с RegExp хоть и быстрее, но "слишкам многа букаф" biggrin (ну, в смысле код намного длиннее).
Да и не вижу я смысла раскрашивать большие массивы. Ведь раскраска нужна для быстрого визуального контроля, а как ты на огромный массив смотреть будешь?
Для больших объёмов данных нужно, наверное, что-то другое придумывать.
Ну, на вскидку (прошу не заплёвывать - идея только что пришла и я её ещё со всех сторон не рассматривал): составлять массив адресов ячеек где присутствует смесь рус-лат букв одинакового начертания и как-то просматривать только его.



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеСаш, интересный, конечно, вариант.
Но мне, к счастью, огромных массивов данных обрабатывать не надо. Поэтому твой вариант с RegExp хоть и быстрее, но "слишкам многа букаф" biggrin (ну, в смысле код намного длиннее).
Да и не вижу я смысла раскрашивать большие массивы. Ведь раскраска нужна для быстрого визуального контроля, а как ты на огромный массив смотреть будешь?
Для больших объёмов данных нужно, наверное, что-то другое придумывать.
Ну, на вскидку (прошу не заплёвывать - идея только что пришла и я её ещё со всех сторон не рассматривал): составлять массив адресов ячеек где присутствует смесь рус-лат букв одинакового начертания и как-то просматривать только его.

Автор - Alex_ST
Дата добавления - 28.11.2012 в 21:40
ikki Дата: Среда, 28.11.2012, 21:48 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
увы, я пока не могу придумать, что мне с этим делать smile
но одно применение есть - пугать ответственных за ввод данных и пилюлей отвешивать килограммами.
реально - раздам завтра свою разукрашку "по принадлежности" - снабженцам, производственникам, отделу продаж...
пусть хотя бы полюбуются на этот кошмар sad
имхо, для быстрой визуальной оценки качества данных - самое оно. wink


помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki


Сообщение отредактировал ikki - Среда, 28.11.2012, 21:51
 
Ответить
Сообщениеувы, я пока не могу придумать, что мне с этим делать smile
но одно применение есть - пугать ответственных за ввод данных и пилюлей отвешивать килограммами.
реально - раздам завтра свою разукрашку "по принадлежности" - снабженцам, производственникам, отделу продаж...
пусть хотя бы полюбуются на этот кошмар sad
имхо, для быстрой визуальной оценки качества данных - самое оно. wink

Автор - ikki
Дата добавления - 28.11.2012 в 21:48
Alex_ST Дата: Среда, 28.11.2012, 22:05 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
Ну, Саш, ради того чтобы со смаком и обоснованно раздать люлей можно и подождать немного biggrin
("Месть - это блюдо, которое подают холодным")

А вообще-то когда мне было известно, что в экспортированной из Access'a таблице должны быть только русские или только латинские буквы, я давно-давно написАл две процедурки по замене "близнецов" (принципиально для примера оставил чуть разные методы)



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеНу, Саш, ради того чтобы со смаком и обоснованно раздать люлей можно и подождать немного biggrin
("Месть - это блюдо, которое подают холодным")

А вообще-то когда мне было известно, что в экспортированной из Access'a таблице должны быть только русские или только латинские буквы, я давно-давно написАл две процедурки по замене "близнецов" (принципиально для примера оставил чуть разные методы)

Автор - Alex_ST
Дата добавления - 28.11.2012 в 22:05
ikki Дата: Среда, 28.11.2012, 22:19 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
спасибо, может пригодиться (и, конечно, не только мне).
но у меня ситуация несколько сложнее - и русские, и латинские символы могут быть.
зависит от контекста.
в основном - определяется стандартами, гостами, ту и проч.

ну, к примеру, болт по гост 7805-70
там куча букв и цифр вперемешку, часть - однозначно должны быть русские, часть - латинские.
ну ладно, перепутали...
ну уж хотя бы делайте это единообразно! smile
а то болт М6 - с русской буквой М, а соседний М5 - с латинской.
марка стали 08кп - конечно, русскими, а 40Х - с какого-то перепугу латинскими.
ну и т.п.

вот эту-то разницу как раз и видно хорошо.
а как это дело обрабатывать (точнее - перерабатывать) - буду думать...
есть пара вариантов - самому допоздна и на выходных ковыряться с регулярками для каждого варианта, или отдать "специалистам" для ручного исправления - вместе с пилюлями biggrin


помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki


Сообщение отредактировал ikki - Среда, 28.11.2012, 22:20
 
Ответить
Сообщениеспасибо, может пригодиться (и, конечно, не только мне).
но у меня ситуация несколько сложнее - и русские, и латинские символы могут быть.
зависит от контекста.
в основном - определяется стандартами, гостами, ту и проч.

ну, к примеру, болт по гост 7805-70
там куча букв и цифр вперемешку, часть - однозначно должны быть русские, часть - латинские.
ну ладно, перепутали...
ну уж хотя бы делайте это единообразно! smile
а то болт М6 - с русской буквой М, а соседний М5 - с латинской.
марка стали 08кп - конечно, русскими, а 40Х - с какого-то перепугу латинскими.
ну и т.п.

вот эту-то разницу как раз и видно хорошо.
а как это дело обрабатывать (точнее - перерабатывать) - буду думать...
есть пара вариантов - самому допоздна и на выходных ковыряться с регулярками для каждого варианта, или отдать "специалистам" для ручного исправления - вместе с пилюлями biggrin

Автор - ikki
Дата добавления - 28.11.2012 в 22:19
Alex_ST Дата: Среда, 28.11.2012, 23:28 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
Quote (ikki)
и русские, и латинские символы могут быть. зависит от контекста.

Знакомая ситуация на работе: шнур (патчкорд) оптический одномодовый (SM - Single Mode) СТАНДАРТНО в спецификациях везде обозначается на смеси рус-лат ШО SM biggrin



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение
Quote (ikki)
и русские, и латинские символы могут быть. зависит от контекста.

Знакомая ситуация на работе: шнур (патчкорд) оптический одномодовый (SM - Single Mode) СТАНДАРТНО в спецификациях везде обозначается на смеси рус-лат ШО SM biggrin

Автор - Alex_ST
Дата добавления - 28.11.2012 в 23:28
boa Дата: Пятница, 14.02.2020, 10:08 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 148 ±
Замечаний: 0% ±

2013, 365
Да, проблема стара как мир.
в свое время написал функцию листа для быстрого выявления и исправления латинских символов в английском тексте.
Как вариант, тоже может быть полезна пользователям
[vba]
Код
Function CyrInEng$(MyRange As Variant, Optional Paint As Boolean = True)
'' Author:  boa
'' Written: 08.12.2017
'' Edited:
'  Description: Отмечает красным цветом не латинские символы в исходном тексте и возвращает результат с подменой этих символов на английские.
    Dim i&:
    Dim sText$: sText = MyRange '.Text
    Dim LangCyr(): LangCyr = Array("Е", "е", "Т", "І", "і", "О", "о", "Р", "р", "А", "а", "Н", "К", "к", "Х", "х", "С", "с", "В", "М", "у", VBA.Chr(190), VBA.Chr(189), VBA.Chr(160))
    Dim LangEng(): LangEng = Array("E", "e", "T", "I", "i", "O", "o", "P", "p", "A", "a", "H", "K", "k", "X", "x", "C", "c", "B", "M", "y", VBA.Chr(115), VBA.Chr(83), VBA.Chr(32))  ' s и S
    If Paint Then '    красим символы кирилицы в источнике
        For i = 1 To VBA.Len(sText)
            If Not (UCase(VBA.Mid(sText, i, 1)) Like "[A-Z]" Or IsNumeric(VBA.Mid(sText, i, 1)) Or VBA.Mid(sText, i, 1) Like "[ #,.;:_@%$*&+/|\'`’~()-]") Then MyRange.Characters(Start:=i, length:=1).Font.Color = vbRed
        Next
    End If
    For i = LBound(LangCyr) To UBound(LangCyr): sText = VBA.Replace(sText, LangCyr(i), LangEng(i), , , vbBinaryCompare): Next
    CyrInEng$ = sText
End Function
[/vba]
И вот такой еще нашел
[vba]
Код
Function ReplaceTranslit$(ByVal sText As String, Optional Sequence$ = "EN-RU")
'' Author:  boa
'' Written: 14.05.2018
'' Edited:
'  Description: Находит английские символы в исходном тексте и возвращает результат с подменой этих символов на кирилические.
    Dim i&:
    Dim LangCyr(): LangCyr = Array("Е", "е", "Т", "І", "і", "О", "о", "Р", "р", "А", "а", "Н", "К", "к", "Х", "х", "С", "с", "В", "М", "у")
    Dim LangEng(): LangEng = Array("E", "e", "T", "I", "i", "O", "o", "P", "p", "A", "a", "H", "K", "k", "X", "x", "C", "c", "B", "M", "y")
    If Sequence$ = "EN-RU" Then For i = LBound(LangEng) To UBound(LangEng): sText = Replace(sText, LangEng(i), LangCyr(i), , , vbBinaryCompare): Next
    If Sequence$ = "RU-EN" Then For i = LBound(LangCyr) To UBound(LangCyr): sText = Replace(sText, LangCyr(i), LangEng(i), , , vbBinaryCompare): Next
    ReplaceTranslit$ = sText
End Function
[/vba]




Сообщение отредактировал boa - Пятница, 14.02.2020, 11:32
 
Ответить
СообщениеДа, проблема стара как мир.
в свое время написал функцию листа для быстрого выявления и исправления латинских символов в английском тексте.
Как вариант, тоже может быть полезна пользователям
[vba]
Код
Function CyrInEng$(MyRange As Variant, Optional Paint As Boolean = True)
'' Author:  boa
'' Written: 08.12.2017
'' Edited:
'  Description: Отмечает красным цветом не латинские символы в исходном тексте и возвращает результат с подменой этих символов на английские.
    Dim i&:
    Dim sText$: sText = MyRange '.Text
    Dim LangCyr(): LangCyr = Array("Е", "е", "Т", "І", "і", "О", "о", "Р", "р", "А", "а", "Н", "К", "к", "Х", "х", "С", "с", "В", "М", "у", VBA.Chr(190), VBA.Chr(189), VBA.Chr(160))
    Dim LangEng(): LangEng = Array("E", "e", "T", "I", "i", "O", "o", "P", "p", "A", "a", "H", "K", "k", "X", "x", "C", "c", "B", "M", "y", VBA.Chr(115), VBA.Chr(83), VBA.Chr(32))  ' s и S
    If Paint Then '    красим символы кирилицы в источнике
        For i = 1 To VBA.Len(sText)
            If Not (UCase(VBA.Mid(sText, i, 1)) Like "[A-Z]" Or IsNumeric(VBA.Mid(sText, i, 1)) Or VBA.Mid(sText, i, 1) Like "[ #,.;:_@%$*&+/|\'`’~()-]") Then MyRange.Characters(Start:=i, length:=1).Font.Color = vbRed
        Next
    End If
    For i = LBound(LangCyr) To UBound(LangCyr): sText = VBA.Replace(sText, LangCyr(i), LangEng(i), , , vbBinaryCompare): Next
    CyrInEng$ = sText
End Function
[/vba]
И вот такой еще нашел
[vba]
Код
Function ReplaceTranslit$(ByVal sText As String, Optional Sequence$ = "EN-RU")
'' Author:  boa
'' Written: 14.05.2018
'' Edited:
'  Description: Находит английские символы в исходном тексте и возвращает результат с подменой этих символов на кирилические.
    Dim i&:
    Dim LangCyr(): LangCyr = Array("Е", "е", "Т", "І", "і", "О", "о", "Р", "р", "А", "а", "Н", "К", "к", "Х", "х", "С", "с", "В", "М", "у")
    Dim LangEng(): LangEng = Array("E", "e", "T", "I", "i", "O", "o", "P", "p", "A", "a", "H", "K", "k", "X", "x", "C", "c", "B", "M", "y")
    If Sequence$ = "EN-RU" Then For i = LBound(LangEng) To UBound(LangEng): sText = Replace(sText, LangEng(i), LangCyr(i), , , vbBinaryCompare): Next
    If Sequence$ = "RU-EN" Then For i = LBound(LangCyr) To UBound(LangCyr): sText = Replace(sText, LangCyr(i), LangEng(i), , , vbBinaryCompare): Next
    ReplaceTranslit$ = sText
End Function
[/vba]

Автор - boa
Дата добавления - 14.02.2020 в 10:08
InExSu Дата: Воскресенье, 16.02.2020, 13:12 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 614
Репутация: 93 ±
Замечаний: 0% ±

Excel 2010
Привет!

Какие выгоды нам несёт использование VBA.функция, вместо функция ?


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеПривет!

Какие выгоды нам несёт использование VBA.функция, вместо функция ?

Автор - InExSu
Дата добавления - 16.02.2020 в 13:12
boa Дата: Воскресенье, 16.02.2020, 22:26 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 148 ±
Замечаний: 0% ±

2013, 365
InExSu,
Просто, полный синтаксис
по тексту понятно к чему, относится функция.
ведь есть одноименные функции относящиеся и к вба, и к эксель...
а выгода... например, поставив точку после VBA и начав набирать имя функции, она появится в подсказке.


 
Ответить
СообщениеInExSu,
Просто, полный синтаксис
по тексту понятно к чему, относится функция.
ведь есть одноименные функции относящиеся и к вба, и к эксель...
а выгода... например, поставив точку после VBA и начав набирать имя функции, она появится в подсказке.

Автор - boa
Дата добавления - 16.02.2020 в 22:26
InExSu Дата: Понедельник, 17.02.2020, 08:25 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 614
Репутация: 93 ±
Замечаний: 0% ±

Excel 2010
Просто, полный синтаксис

не, неполный. есть ещё полнее:
VBA.Strings.Chr

Вы упоминаете UCase. Он тоже VBA.Strings.UCase

FYI: функции, оканчивающиеся на $ быстрее оных же без $

одноименные функции относящиеся и к вба, и к эксель

и что, были забавные случаи путаниц и "VBA." спасала?

А в общем - большущее спасибо! Буду чаще пользоваться F2


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
Сообщение
Просто, полный синтаксис

не, неполный. есть ещё полнее:
VBA.Strings.Chr

Вы упоминаете UCase. Он тоже VBA.Strings.UCase

FYI: функции, оканчивающиеся на $ быстрее оных же без $

одноименные функции относящиеся и к вба, и к эксель

и что, были забавные случаи путаниц и "VBA." спасала?

А в общем - большущее спасибо! Буду чаще пользоваться F2

Автор - InExSu
Дата добавления - 17.02.2020 в 08:25
boa Дата: Понедельник, 17.02.2020, 10:23 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 148 ±
Замечаний: 0% ±

2013, 365
и что, были забавные случаи путаниц и "VBA." спасала?

нет, в моей практике не было :) просто знаю когда и как использовать VBA.InputBox и/или Excel.Application.InputBox
Но у меня есть один клиент "повернутый" на этом синтаксисе, поэтому большинство макросов в "загашнике" было приведено к единому стандарту.
функции, оканчивающиеся на $ быстрее оных же без $

спасибо. учту в дальнейшем.


 
Ответить
Сообщение
и что, были забавные случаи путаниц и "VBA." спасала?

нет, в моей практике не было :) просто знаю когда и как использовать VBA.InputBox и/или Excel.Application.InputBox
Но у меня есть один клиент "повернутый" на этом синтаксисе, поэтому большинство макросов в "загашнике" было приведено к единому стандарту.
функции, оканчивающиеся на $ быстрее оных же без $

спасибо. учту в дальнейшем.

Автор - boa
Дата добавления - 17.02.2020 в 10:23
Alex_ST Дата: Понедельник, 17.02.2020, 12:32 | Сообщение № 15
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
Да, проблема стара как мир.
Ну, вообще-то топик начат в 2011 году, а окончательные варианты (с окраской букв и с автозаменой) я выложил в конце 2012...
А по поводу Вашей функции с окрашиванием, то я не понял, каким должен быть результат?
Формулы (в типовом из применении, как у Вас) не меняют формат ячейки, поэтому изменить, а тем более ВЫБОРОЧНО, цвет букв, написанных в "не той" раскладке не могут.
Думал, может я что-то не понял, поэтому на всякий случай решил проверить:
создал новую книгу, в ней - модуль, вставил в него Ваш скрипт формулы
[vba]
Код
Function CyrInEng$(MyRange As Variant, Optional Paint As Boolean = True)
'' Author:  boa
'' Written: 08.12.2017
'' Edited:
'  Description: Отмечает красным цветом не латинские символы в исходном тексте и возвращает результат с подменой этих символов на английские.
    Dim i&:
    Dim sText$: sText = MyRange '.Text
    Dim LangCyr(): LangCyr = Array("Е", "е", "Т", "І", "і", "О", "о", "Р", "р", "А", "а", "Н", "К", "к", "Х", "х", "С", "с", "В", "М", "у", VBA.Chr(190), VBA.Chr(189), VBA.Chr(160))
    Dim LangEng(): LangEng = Array("E", "e", "T", "I", "i", "O", "o", "P", "p", "A", "a", "H", "K", "k", "X", "x", "C", "c", "B", "M", "y", VBA.Chr(115), VBA.Chr(83), VBA.Chr(32))  ' s и S
    If Paint Then '    красим символы кирилицы в источнике
        For i = 1 To VBA.Len(sText)
            If Not (UCase(VBA.Mid(sText, i, 1)) Like "[A-Z]" Or IsNumeric(VBA.Mid(sText, i, 1)) Or VBA.Mid(sText, i, 1) Like "[ #,.;:_@%$*&+/|\'`’~()-]") Then MyRange.Characters(Start:=i, Length:=1).Font.Color = vbRed
        Next
    End If
    For i = LBound(LangCyr) To UBound(LangCyr): sText = VBA.Replace(sText, LangCyr(i), LangEng(i), , , vbBinaryCompare): Next
    CyrInEng$ = sText
End Function
[/vba]
А на листе книги тупо набил в ячейки A1, A2, A3:
[vba]
Код
qwerty
йцукенг
фывапрzxcvbn
[/vba] и в столбце В тупо, протягиванием, обработал их Вашими формулами
[vba]
Код
B1=CyrInEng(A1;1)
B2=CyrInEng(A2;1)
B3=CyrInEng(A3;1)
[/vba]
Как и ожидалось, в ячейках В1...В3 я получил НЕ ОКРАШЕННЫЙ ИСХОДНЫЙ текст [vba]
Код
qwerty
йцукенг
фывапрzxcvbn
[/vba]



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Понедельник, 17.02.2020, 12:37
 
Ответить
Сообщение
Да, проблема стара как мир.
Ну, вообще-то топик начат в 2011 году, а окончательные варианты (с окраской букв и с автозаменой) я выложил в конце 2012...
А по поводу Вашей функции с окрашиванием, то я не понял, каким должен быть результат?
Формулы (в типовом из применении, как у Вас) не меняют формат ячейки, поэтому изменить, а тем более ВЫБОРОЧНО, цвет букв, написанных в "не той" раскладке не могут.
Думал, может я что-то не понял, поэтому на всякий случай решил проверить:
создал новую книгу, в ней - модуль, вставил в него Ваш скрипт формулы
[vba]
Код
Function CyrInEng$(MyRange As Variant, Optional Paint As Boolean = True)
'' Author:  boa
'' Written: 08.12.2017
'' Edited:
'  Description: Отмечает красным цветом не латинские символы в исходном тексте и возвращает результат с подменой этих символов на английские.
    Dim i&:
    Dim sText$: sText = MyRange '.Text
    Dim LangCyr(): LangCyr = Array("Е", "е", "Т", "І", "і", "О", "о", "Р", "р", "А", "а", "Н", "К", "к", "Х", "х", "С", "с", "В", "М", "у", VBA.Chr(190), VBA.Chr(189), VBA.Chr(160))
    Dim LangEng(): LangEng = Array("E", "e", "T", "I", "i", "O", "o", "P", "p", "A", "a", "H", "K", "k", "X", "x", "C", "c", "B", "M", "y", VBA.Chr(115), VBA.Chr(83), VBA.Chr(32))  ' s и S
    If Paint Then '    красим символы кирилицы в источнике
        For i = 1 To VBA.Len(sText)
            If Not (UCase(VBA.Mid(sText, i, 1)) Like "[A-Z]" Or IsNumeric(VBA.Mid(sText, i, 1)) Or VBA.Mid(sText, i, 1) Like "[ #,.;:_@%$*&+/|\'`’~()-]") Then MyRange.Characters(Start:=i, Length:=1).Font.Color = vbRed
        Next
    End If
    For i = LBound(LangCyr) To UBound(LangCyr): sText = VBA.Replace(sText, LangCyr(i), LangEng(i), , , vbBinaryCompare): Next
    CyrInEng$ = sText
End Function
[/vba]
А на листе книги тупо набил в ячейки A1, A2, A3:
[vba]
Код
qwerty
йцукенг
фывапрzxcvbn
[/vba] и в столбце В тупо, протягиванием, обработал их Вашими формулами
[vba]
Код
B1=CyrInEng(A1;1)
B2=CyrInEng(A2;1)
B3=CyrInEng(A3;1)
[/vba]
Как и ожидалось, в ячейках В1...В3 я получил НЕ ОКРАШЕННЫЙ ИСХОДНЫЙ текст [vba]
Код
qwerty
йцукенг
фывапрzxcvbn
[/vba]

Автор - Alex_ST
Дата добавления - 17.02.2020 в 12:32
boa Дата: Понедельник, 17.02.2020, 17:07 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 148 ±
Замечаний: 0% ±

2013, 365
Alex_ST,
при всем уважении,
данная функция таки меняет цвет символов внутри ячейки. и вызывается с листа.
Для наглядности, добавил волотильность функции.

Ну, вообще-то топик начат в 2011 году
я видел даты, но как-то ранее в него не попадал, а тут недавно по ссылке перешел. Извините, если не уместно.

я не понял, каким должен быть результат?
смотрите пример.
К сообщению приложен файл: CyrInEng.xlsb(25.6 Kb)


 
Ответить
СообщениеAlex_ST,
при всем уважении,
данная функция таки меняет цвет символов внутри ячейки. и вызывается с листа.
Для наглядности, добавил волотильность функции.

Ну, вообще-то топик начат в 2011 году
я видел даты, но как-то ранее в него не попадал, а тут недавно по ссылке перешел. Извините, если не уместно.

я не понял, каким должен быть результат?
смотрите пример.

Автор - boa
Дата добавления - 17.02.2020 в 17:07
Alex_ST Дата: Вторник, 18.02.2020, 13:18 | Сообщение № 17
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
boa,
прошу прощения, но даже с добавленной волотильностью в Вашем примере у меня красным выделены только символы в диапазонах исходных данных G8:G11 K8:K11 (очевидно, В РУЧНУЮ при вводе)
В ячейках, содержащих вычисления Вашей формулой цвет символов внутри ячейки не изменяется.
Что в общем-то и ожидалось, т.к. в Excel формулы не могут менять тип шрифта и цвет отдельных символов текста в ячейке!
К сообщению приложен файл: 2101393.png(95.3 Kb)



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщениеboa,
прошу прощения, но даже с добавленной волотильностью в Вашем примере у меня красным выделены только символы в диапазонах исходных данных G8:G11 K8:K11 (очевидно, В РУЧНУЮ при вводе)
В ячейках, содержащих вычисления Вашей формулой цвет символов внутри ячейки не изменяется.
Что в общем-то и ожидалось, т.к. в Excel формулы не могут менять тип шрифта и цвет отдельных символов текста в ячейке!

Автор - Alex_ST
Дата добавления - 18.02.2020 в 13:18
boa Дата: Вторник, 18.02.2020, 18:09 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 148 ±
Замечаний: 0% ±

2013, 365
Алексей,

красным выделены только символы в диапазонах исходных данных
цвет символов в ячейках меняет именно функция(ни какого ручного ввода), а в ячейке, в которой записана функция символы уже заменены на их англ. аналоги. Если разложить по кодам(char), то это будет видно.
в Excel формулы не могут менять тип шрифта и цвет отдельных символов текста в ячейке!
ошибочное утверждение.
измените цвет шрифта исходных ячеек на произвольный(кроме красного) и пересчитайте (F9)
простой примерчик для теста:
[vba]
Код
Function test(MyRange As Range)
  MyRange.Font.Color = vbRed
End Function
[/vba]


 
Ответить
СообщениеАлексей,

красным выделены только символы в диапазонах исходных данных
цвет символов в ячейках меняет именно функция(ни какого ручного ввода), а в ячейке, в которой записана функция символы уже заменены на их англ. аналоги. Если разложить по кодам(char), то это будет видно.
в Excel формулы не могут менять тип шрифта и цвет отдельных символов текста в ячейке!
ошибочное утверждение.
измените цвет шрифта исходных ячеек на произвольный(кроме красного) и пересчитайте (F9)
простой примерчик для теста:
[vba]
Код
Function test(MyRange As Range)
  MyRange.Font.Color = vbRed
End Function
[/vba]

Автор - boa
Дата добавления - 18.02.2020 в 18:09
Alex_ST Дата: Вторник, 18.02.2020, 21:54 | Сообщение № 19
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3110
Репутация: 586 ±
Замечаний: 0% ±

2003
Андрей,
Вы пишете
цвет символов в ячейках меняет именно функция(ни какого ручного ввода)
но в выложенном Вами примере формула используется только для обработки данных из диапазонов G8:G11; K8:K11 и в диапазоны H8:H11; L8:L11 она, как и положено формулам листа выводит "монохромные" результаты.
Данные в ячейках G8:G11; K8:K11 - константы, а не вычисленные формулой. Достаточно просто повыделять эти ячейки, чтобы удостовериться - в строке формул ЗНАЧЕНИЯ, а не формулы.
Где происходит вычисление цвета символов ФОРМУЛОЙ ЛИСТА? В именах я проверял - там вычислений нет. В УФ тоже не увидел.
(Сейчас проверить ещё раз не могу - у меня дома только Excel 2003 и Ваш CyrInEng.xlsb конвертер обрабатывать отказывается, завтра на работе ещё раз проверю).
Чтобы прекратить диспут "работает-не работает" выложите, пожалуйста, ещё один пример, в котором будут исходные данные - несколько монохромных ячеек с вручную введёнными текстами со смесью РУС-ЛАТ и в других ячейках - результат формулы обработки исходных данных Вашей формулой.
Тогда, выбрав ячейку, в строке формул можно будет однозначно определить где формула, а где текст.
И я очень сомневаюсь, что текст в ячейках с формулами будет разноцветным...
----------
Вот я даже файл-пример слепил такой же, как и в посте сегодня утром.
У меня результаты обработки - МОНОХРОМНЫЕ!
Докажите на этом простом примере, что формула может раскрашивать текст
Формулы листа НЕ МОГУТ менять формат ячейки, а тем более - раскрашивать символы текста! Это аксиома Excel.
Изменить формат ВСЕЙ ЯЧЕЙКИ ЦЕЛИКОМ может, конечно, формула в УФ или в именах (хотя в этом, честно говоря сомневаюсь, т.к. никогда не пробовал запихнуть пользовательскую формулу в вычисляемые именованные диапазоны)
К сообщению приложен файл: CyrInEng-2-.xls(28.5 Kb)



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Вторник, 18.02.2020, 22:12
 
Ответить
СообщениеАндрей,
Вы пишете
цвет символов в ячейках меняет именно функция(ни какого ручного ввода)
но в выложенном Вами примере формула используется только для обработки данных из диапазонов G8:G11; K8:K11 и в диапазоны H8:H11; L8:L11 она, как и положено формулам листа выводит "монохромные" результаты.
Данные в ячейках G8:G11; K8:K11 - константы, а не вычисленные формулой. Достаточно просто повыделять эти ячейки, чтобы удостовериться - в строке формул ЗНАЧЕНИЯ, а не формулы.
Где происходит вычисление цвета символов ФОРМУЛОЙ ЛИСТА? В именах я проверял - там вычислений нет. В УФ тоже не увидел.
(Сейчас проверить ещё раз не могу - у меня дома только Excel 2003 и Ваш CyrInEng.xlsb конвертер обрабатывать отказывается, завтра на работе ещё раз проверю).
Чтобы прекратить диспут "работает-не работает" выложите, пожалуйста, ещё один пример, в котором будут исходные данные - несколько монохромных ячеек с вручную введёнными текстами со смесью РУС-ЛАТ и в других ячейках - результат формулы обработки исходных данных Вашей формулой.
Тогда, выбрав ячейку, в строке формул можно будет однозначно определить где формула, а где текст.
И я очень сомневаюсь, что текст в ячейках с формулами будет разноцветным...
----------
Вот я даже файл-пример слепил такой же, как и в посте сегодня утром.
У меня результаты обработки - МОНОХРОМНЫЕ!
Докажите на этом простом примере, что формула может раскрашивать текст
Формулы листа НЕ МОГУТ менять формат ячейки, а тем более - раскрашивать символы текста! Это аксиома Excel.
Изменить формат ВСЕЙ ЯЧЕЙКИ ЦЕЛИКОМ может, конечно, формула в УФ или в именах (хотя в этом, честно говоря сомневаюсь, т.к. никогда не пробовал запихнуть пользовательскую формулу в вычисляемые именованные диапазоны)

Автор - Alex_ST
Дата добавления - 18.02.2020 в 21:54
boa Дата: Среда, 19.02.2020, 00:42 | Сообщение № 20
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 148 ±
Замечаний: 0% ±

2013, 365
Алексей
Это аксиома Excel.

обажаю разрушать аксиомы.
текст прекрасно красится. как целиком (функцию привел в посте 18), так и посимвольно как в моей функции.

в диапазонах G8:G11; K8:K11 имеем исходный текст(как вы правильно заметили "константы") с перемешанными буквами рус/лат
в ячейки H8:H11; L8:L11 вводим формулу(кстати, почему вы решили, что она должна быть массивной)
после вычисления, текст в ячейках(русские символы) G8:G11; K8:K11 окрашивается в красный цвет и оставляет без изменений цвет текста(монохромный) в самой ячейке с формулой H8:H11; L8:L11. Но, в ячейках с формулой русские символы будут заменены на латинские одинаковые в написании LangCyr = Array("Е",...) на LangEng = Array("E", ...)
я даже видос записал, но он не прошел по размеру для вложения :(
ваш файлик из предыдущего сообщения сохранил в автоматический цветах текста(монохромный черный). Если макросы не включены, то он таким же и останется(Снимок1). А если разрешить макросы то "константы" перекрасятся(Снимок2)
К сообщению приложен файл: Downloads.zip(96.2 Kb)




Сообщение отредактировал boa - Среда, 19.02.2020, 00:59
 
Ответить
СообщениеАлексей
Это аксиома Excel.

обажаю разрушать аксиомы.
текст прекрасно красится. как целиком (функцию привел в посте 18), так и посимвольно как в моей функции.

в диапазонах G8:G11; K8:K11 имеем исходный текст(как вы правильно заметили "константы") с перемешанными буквами рус/лат
в ячейки H8:H11; L8:L11 вводим формулу(кстати, почему вы решили, что она должна быть массивной)
после вычисления, текст в ячейках(русские символы) G8:G11; K8:K11 окрашивается в красный цвет и оставляет без изменений цвет текста(монохромный) в самой ячейке с формулой H8:H11; L8:L11. Но, в ячейках с формулой русские символы будут заменены на латинские одинаковые в написании LangCyr = Array("Е",...) на LangEng = Array("E", ...)
я даже видос записал, но он не прошел по размеру для вложения :(
ваш файлик из предыдущего сообщения сохранил в автоматический цветах текста(монохромный черный). Если макросы не включены, то он таким же и останется(Снимок1). А если разрешить макросы то "константы" перекрасятся(Снимок2)

Автор - boa
Дата добавления - 19.02.2020 в 00:42
Мир MS Excel » Вопросы и решения » Готовые решения » Макрос "Color_RUS_LAT" (Выделяет РУС-символы в Selection ЗЕЛЁНЫМ, а LAT - КРАСНЫМ)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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