Для обработки-сведения в общую учётную таблицу плодов трудов "умельцев", которые мешают в тексте латиницу и кириллицу, написал макрос, выделяющий такие буквы разным цветом: [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" и регулярно пользуюсь. Здорово помогает.
Для обработки-сведения в общую учётную таблицу плодов трудов "умельцев", которые мешают в тексте латиницу и кириллицу, написал макрос, выделяющий такие буквы разным цветом: [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
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Суббота, 29.01.2011, 22:50
Совсем забыл про этот свой пост. А ведь вносил коррекцию: забыл про русские ё и Ё, коды которых размещены в таблице символов отдельно. Вот так будет точнее: [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]
Совсем забыл про этот свой пост. А ведь вносил коррекцию: забыл про русские ё и Ё, коды которых размещены в таблице символов отдельно. Вот так будет точнее: [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
приведенные макросы всем хороши, одна беда - на больших объемах работают не слишком шустро. у меня аналогичный макрос на 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 раза). думаю, разница во времени может отличаться в зависимости от того, насколько сильно "перемешаны" русские и латинские символы внутри строк, насколько длинные сами строки и т.п...
но, как вариант - можно использовать, имхо.
приведенные макросы всем хороши, одна беда - на больших объемах работают не слишком шустро. у меня аналогичный макрос на 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 раза). думаю, разница во времени может отличаться в зависимости от того, насколько сильно "перемешаны" русские и латинские символы внутри строк, насколько длинные сами строки и т.п...
Саш, интересный, конечно, вариант. Но мне, к счастью, огромных массивов данных обрабатывать не надо. Поэтому твой вариант с RegExp хоть и быстрее, но "слишкам многа букаф" (ну, в смысле код намного длиннее). Да и не вижу я смысла раскрашивать большие массивы. Ведь раскраска нужна для быстрого визуального контроля, а как ты на огромный массив смотреть будешь? Для больших объёмов данных нужно, наверное, что-то другое придумывать. Ну, на вскидку (прошу не заплёвывать - идея только что пришла и я её ещё со всех сторон не рассматривал): составлять массив адресов ячеек где присутствует смесь рус-лат букв одинакового начертания и как-то просматривать только его.
Саш, интересный, конечно, вариант. Но мне, к счастью, огромных массивов данных обрабатывать не надо. Поэтому твой вариант с RegExp хоть и быстрее, но "слишкам многа букаф" (ну, в смысле код намного длиннее). Да и не вижу я смысла раскрашивать большие массивы. Ведь раскраска нужна для быстрого визуального контроля, а как ты на огромный массив смотреть будешь? Для больших объёмов данных нужно, наверное, что-то другое придумывать. Ну, на вскидку (прошу не заплёвывать - идея только что пришла и я её ещё со всех сторон не рассматривал): составлять массив адресов ячеек где присутствует смесь рус-лат букв одинакового начертания и как-то просматривать только его.Alex_ST
увы, я пока не могу придумать, что мне с этим делать но одно применение есть - пугать ответственных за ввод данных и пилюлей отвешивать килограммами. реально - раздам завтра свою разукрашку "по принадлежности" - снабженцам, производственникам, отделу продаж... пусть хотя бы полюбуются на этот кошмар имхо, для быстрой визуальной оценки качества данных - самое оно.
увы, я пока не могу придумать, что мне с этим делать но одно применение есть - пугать ответственных за ввод данных и пилюлей отвешивать килограммами. реально - раздам завтра свою разукрашку "по принадлежности" - снабженцам, производственникам, отделу продаж... пусть хотя бы полюбуются на этот кошмар имхо, для быстрой визуальной оценки качества данных - самое оно. ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
Сообщение отредактировал ikki - Среда, 28.11.2012, 21:51
Ну, Саш, ради того чтобы со смаком и обоснованно раздать люлей можно и подождать немного ("Месть - это блюдо, которое подают холодным")
А вообще-то когда мне было известно, что в экспортированной из Access'a таблице должны быть только русские или только латинские буквы, я давно-давно написАл две процедурки по замене "близнецов" (принципиально для примера оставил чуть разные методы)
[vba]
Code
Sub Repair_RUS() ' заменить латинские буквы такими же по начертанию русскими If TypeName(Selection) <> "Range" Then Exit Sub With ActiveSheet.UsedRange If Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub Dim LATChr$: LATChr = "CcEeTOopPAaHKkXxBM" Dim RUSChr$: RUSChr = "СсЕеТОорРАаНКкХхВМ" Dim i% For i = 1 To Len(LATChr) Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _ What:=Mid(LATChr, i, 1), _ Replacement:=Mid(RUSChr, i, 1), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True Next i End With End Sub Sub Repair_LAT() ' заменить русские буквы такими же по начертанию латинскими If TypeName(Selection) <> "Range" Then Exit Sub With ActiveSheet.UsedRange If Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub Dim arrENG(): arrENG = Split("C c E e T O o p P A a H K k X x B M") Dim arrRUS(): arrRUS = Split("С с Е е Т О о р Р А а Н К к Х х В М") Dim i% For i = 0 To UBound(arrENG) Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _ What:=arrRUS(i), _ Replacement:=arrENG(i), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True Next i End With End Sub
[/vba]
Ну, Саш, ради того чтобы со смаком и обоснованно раздать люлей можно и подождать немного ("Месть - это блюдо, которое подают холодным")
А вообще-то когда мне было известно, что в экспортированной из Access'a таблице должны быть только русские или только латинские буквы, я давно-давно написАл две процедурки по замене "близнецов" (принципиально для примера оставил чуть разные методы)
[vba]
Code
Sub Repair_RUS() ' заменить латинские буквы такими же по начертанию русскими If TypeName(Selection) <> "Range" Then Exit Sub With ActiveSheet.UsedRange If Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub Dim LATChr$: LATChr = "CcEeTOopPAaHKkXxBM" Dim RUSChr$: RUSChr = "СсЕеТОорРАаНКкХхВМ" Dim i% For i = 1 To Len(LATChr) Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _ What:=Mid(LATChr, i, 1), _ Replacement:=Mid(RUSChr, i, 1), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True Next i End With End Sub Sub Repair_LAT() ' заменить русские буквы такими же по начертанию латинскими If TypeName(Selection) <> "Range" Then Exit Sub With ActiveSheet.UsedRange If Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub Dim arrENG(): arrENG = Split("C c E e T O o p P A a H K k X x B M") Dim arrRUS(): arrRUS = Split("С с Е е Т О о р Р А а Н К к Х х В М") Dim i% For i = 0 To UBound(arrENG) Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _ What:=arrRUS(i), _ Replacement:=arrENG(i), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True Next i End With End Sub
спасибо, может пригодиться (и, конечно, не только мне). но у меня ситуация несколько сложнее - и русские, и латинские символы могут быть. зависит от контекста. в основном - определяется стандартами, гостами, ту и проч.
ну, к примеру, болт по гост 7805-70 там куча букв и цифр вперемешку, часть - однозначно должны быть русские, часть - латинские. ну ладно, перепутали... ну уж хотя бы делайте это единообразно! а то болт М6 - с русской буквой М, а соседний М5 - с латинской. марка стали 08кп - конечно, русскими, а 40Х - с какого-то перепугу латинскими. ну и т.п.
вот эту-то разницу как раз и видно хорошо. а как это дело обрабатывать (точнее - перерабатывать) - буду думать... есть пара вариантов - самому допоздна и на выходных ковыряться с регулярками для каждого варианта, или отдать "специалистам" для ручного исправления - вместе с пилюлями
спасибо, может пригодиться (и, конечно, не только мне). но у меня ситуация несколько сложнее - и русские, и латинские символы могут быть. зависит от контекста. в основном - определяется стандартами, гостами, ту и проч.
ну, к примеру, болт по гост 7805-70 там куча букв и цифр вперемешку, часть - однозначно должны быть русские, часть - латинские. ну ладно, перепутали... ну уж хотя бы делайте это единообразно! а то болт М6 - с русской буквой М, а соседний М5 - с латинской. марка стали 08кп - конечно, русскими, а 40Х - с какого-то перепугу латинскими. ну и т.п.
вот эту-то разницу как раз и видно хорошо. а как это дело обрабатывать (точнее - перерабатывать) - буду думать... есть пара вариантов - самому допоздна и на выходных ковыряться с регулярками для каждого варианта, или отдать "специалистам" для ручного исправления - вместе с пилюлями ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
Сообщение отредактировал ikki - Среда, 28.11.2012, 22:20
и русские, и латинские символы могут быть. зависит от контекста.
Знакомая ситуация на работе: шнур (патчкорд) оптический одномодовый (SM - Single Mode) СТАНДАРТНО в спецификациях везде обозначается на смеси рус-лат ШО SM
Quote (ikki)
и русские, и латинские символы могут быть. зависит от контекста.
Знакомая ситуация на работе: шнур (патчкорд) оптический одномодовый (SM - Single Mode) СТАНДАРТНО в спецификациях везде обозначается на смеси рус-лат ШО SMAlex_ST
Да, проблема стара как мир. в свое время написал функцию листа для быстрого выявления и исправления латинских символов в английском тексте. Как вариант, тоже может быть полезна пользователям [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]
Да, проблема стара как мир. в свое время написал функцию листа для быстрого выявления и исправления латинских символов в английском тексте. Как вариант, тоже может быть полезна пользователям [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
InExSu, Просто, полный синтаксис по тексту понятно к чему, относится функция. ведь есть одноименные функции относящиеся и к вба, и к эксель... а выгода... например, поставив точку после VBA и начав набирать имя функции, она появится в подсказке.
InExSu, Просто, полный синтаксис по тексту понятно к чему, относится функция. ведь есть одноименные функции относящиеся и к вба, и к эксель... а выгода... например, поставив точку после VBA и начав набирать имя функции, она появится в подсказке.boa
и что, были забавные случаи путаниц и "VBA." спасала?
нет, в моей практике не было просто знаю когда и как использовать VBA.InputBox и/или Excel.Application.InputBox Но у меня есть один клиент "повернутый" на этом синтаксисе, поэтому большинство макросов в "загашнике" было приведено к единому стандарту.
и что, были забавные случаи путаниц и "VBA." спасала?
нет, в моей практике не было просто знаю когда и как использовать VBA.InputBox и/или Excel.Application.InputBox Но у меня есть один клиент "повернутый" на этом синтаксисе, поэтому большинство макросов в "загашнике" было приведено к единому стандарту.
Ну, вообще-то топик начат в 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]
Ну, вообще-то топик начат в 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]
Alex_ST, при всем уважении, данная функция таки меняет цвет символов внутри ячейки. и вызывается с листа. Для наглядности, добавил волотильность функции.
Alex_ST, при всем уважении, данная функция таки меняет цвет символов внутри ячейки. и вызывается с листа. Для наглядности, добавил волотильность функции.
boa, прошу прощения, но даже с добавленной волотильностью в Вашем примере у меня красным выделены только символы в диапазонах исходных данных G8:G11 K8:K11 (очевидно, В РУЧНУЮ при вводе) В ячейках, содержащих вычисления Вашей формулой цвет символов внутри ячейки не изменяется. Что в общем-то и ожидалось, т.к. в Excel формулы не могут менять тип шрифта и цвет отдельных символов текста в ячейке!
boa, прошу прощения, но даже с добавленной волотильностью в Вашем примере у меня красным выделены только символы в диапазонах исходных данных G8:G11 K8:K11 (очевидно, В РУЧНУЮ при вводе) В ячейках, содержащих вычисления Вашей формулой цвет символов внутри ячейки не изменяется. Что в общем-то и ожидалось, т.к. в Excel формулы не могут менять тип шрифта и цвет отдельных символов текста в ячейке! Alex_ST
красным выделены только символы в диапазонах исходных данных
цвет символов в ячейках меняет именно функция(ни какого ручного ввода), а в ячейке, в которой записана функция символы уже заменены на их англ. аналоги. Если разложить по кодам(char), то это будет видно.
красным выделены только символы в диапазонах исходных данных
цвет символов в ячейках меняет именно функция(ни какого ручного ввода), а в ячейке, в которой записана функция символы уже заменены на их англ. аналоги. Если разложить по кодам(char), то это будет видно.
цвет символов в ячейках меняет именно функция(ни какого ручного ввода)
но в выложенном Вами примере формула используется только для обработки данных из диапазонов G8:G11; K8:K11 и в диапазоны H8:H11; L8:L11 она, как и положено формулам листа выводит "монохромные" результаты. Данные в ячейках G8:G11; K8:K11 - константы, а не вычисленные формулой. Достаточно просто повыделять эти ячейки, чтобы удостовериться - в строке формул ЗНАЧЕНИЯ, а не формулы. Где происходит вычисление цвета символов ФОРМУЛОЙ ЛИСТА? В именах я проверял - там вычислений нет. В УФ тоже не увидел. (Сейчас проверить ещё раз не могу - у меня дома только Excel 2003 и Ваш CyrInEng.xlsb конвертер обрабатывать отказывается, завтра на работе ещё раз проверю). Чтобы прекратить диспут "работает-не работает" выложите, пожалуйста, ещё один пример, в котором будут исходные данные - несколько монохромных ячеек с вручную введёнными текстами со смесью РУС-ЛАТ и в других ячейках - результат формулы обработки исходных данных Вашей формулой. Тогда, выбрав ячейку, в строке формул можно будет однозначно определить где формула, а где текст. И я очень сомневаюсь, что текст в ячейках с формулами будет разноцветным... ---------- Вот я даже файл-пример слепил такой же, как и в посте сегодня утром. У меня результаты обработки - МОНОХРОМНЫЕ! Докажите на этом простом примере, что формула может раскрашивать текст Формулы листа НЕ МОГУТ менять формат ячейки, а тем более - раскрашивать символы текста! Это аксиома Excel. Изменить формат ВСЕЙ ЯЧЕЙКИ ЦЕЛИКОМ может, конечно, формула в УФ или в именах (хотя в этом, честно говоря сомневаюсь, т.к. никогда не пробовал запихнуть пользовательскую формулу в вычисляемые именованные диапазоны)
цвет символов в ячейках меняет именно функция(ни какого ручного ввода)
но в выложенном Вами примере формула используется только для обработки данных из диапазонов G8:G11; K8:K11 и в диапазоны H8:H11; L8:L11 она, как и положено формулам листа выводит "монохромные" результаты. Данные в ячейках G8:G11; K8:K11 - константы, а не вычисленные формулой. Достаточно просто повыделять эти ячейки, чтобы удостовериться - в строке формул ЗНАЧЕНИЯ, а не формулы. Где происходит вычисление цвета символов ФОРМУЛОЙ ЛИСТА? В именах я проверял - там вычислений нет. В УФ тоже не увидел. (Сейчас проверить ещё раз не могу - у меня дома только Excel 2003 и Ваш CyrInEng.xlsb конвертер обрабатывать отказывается, завтра на работе ещё раз проверю). Чтобы прекратить диспут "работает-не работает" выложите, пожалуйста, ещё один пример, в котором будут исходные данные - несколько монохромных ячеек с вручную введёнными текстами со смесью РУС-ЛАТ и в других ячейках - результат формулы обработки исходных данных Вашей формулой. Тогда, выбрав ячейку, в строке формул можно будет однозначно определить где формула, а где текст. И я очень сомневаюсь, что текст в ячейках с формулами будет разноцветным... ---------- Вот я даже файл-пример слепил такой же, как и в посте сегодня утром. У меня результаты обработки - МОНОХРОМНЫЕ! Докажите на этом простом примере, что формула может раскрашивать текст Формулы листа НЕ МОГУТ менять формат ячейки, а тем более - раскрашивать символы текста! Это аксиома Excel. Изменить формат ВСЕЙ ЯЧЕЙКИ ЦЕЛИКОМ может, конечно, формула в УФ или в именах (хотя в этом, честно говоря сомневаюсь, т.к. никогда не пробовал запихнуть пользовательскую формулу в вычисляемые именованные диапазоны)Alex_ST
обажаю разрушать аксиомы. текст прекрасно красится. как целиком (функцию привел в посте 18), так и посимвольно как в моей функции.
в диапазонах G8:G11; K8:K11 имеем исходный текст(как вы правильно заметили "константы") с перемешанными буквами рус/лат в ячейки H8:H11; L8:L11 вводим формулу(кстати, почему вы решили, что она должна быть массивной) после вычисления, текст в ячейках(русские символы) G8:G11; K8:K11 окрашивается в красный цвет и оставляет без изменений цвет текста(монохромный) в самой ячейке с формулой H8:H11; L8:L11. Но, в ячейках с формулой русские символы будут заменены на латинские одинаковые в написании LangCyr = Array("Е",...) на LangEng = Array("E", ...) я даже видос записал, но он не прошел по размеру для вложения ваш файлик из предыдущего сообщения сохранил в автоматический цветах текста(монохромный черный). Если макросы не включены, то он таким же и останется(Снимок1). А если разрешить макросы то "константы" перекрасятся(Снимок2)
обажаю разрушать аксиомы. текст прекрасно красится. как целиком (функцию привел в посте 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
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
(ну, в смысле код намного длиннее). 
просто знаю когда и как использовать VBA.InputBox и/или Excel.Application.InputBox
