Поиск символов латиницы в русском тексте

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

Использование символов латиницы в русском тексте порождает огромное количество проблем. От путаницы при банальной сортировке по алфавиту до некорректной консолидации данных при автоматическом объединении нескольких таблиц в одну.

Выискивать похожие по виду символы и проверять не являются ли они символами английской раскладки крайне муторно. Поэтому поищем более изящные варианты...

Способ 1. Шрифт без кириллицы

Выделите диапазон ячеек с проверяемым текстом и временно установите для него любой шрифт не содержащий кириллицу, например Albertus или любой аналогичный (находится методом тыка). Внешний вид символов кириллицы и латиницы станет отличаться и можно будет легко визуально локализовать некорректные символы:

latin1.png

Способ 2. Функция IsLatin на VBA

Создадим пользовательскую функцию (назовем ее, например, IsLatin), которая будет проверять - присутствуют ли в заданной ячейке символы английского алфавита и выдавать в качестве результата логическое значение ИСТИНА или ЛОЖЬ.

Откройте редактор Visual Basic сочетанием клавиш ALT+F11 или в старых версиях Excel - через меню Сервис - Макрос - Редактор Visual Basic (Tools - Macro - Visual Basic Editor), вставьте новый модуль (меню Insert - Module) и скопируйте туда текст этой функции:

Public Function IsLatin(str As String)
    str = LCase(str)
    LatinAlphbet = "*[abcdefghijklmnopqrstuvwxyz]*"
    If str Like LatinAlphbet Then
        IsLatin = True
    Else
        IsLatin = False
    End If
End Function

Закройте редактор Visual Basic и вернитесь в Excel.

Теперь в Мастере функций в категории Определенные пользователем (User Defined) можно найти нашу функцию IsLatin и воспользоваться ей. Синтаксис функции следующий:

=IsLatin(A2)

где для примера А2 - это адрес ячейки, содержащей текст

Функция выдаст значение ИСТИНА (TRUE), если найдет в тексте А2 хотя бы один символ латиницы. В противном случае функция вернет значение ЛОЖЬ (FALSE):

latin2.png

Способ 3. Подсветка символов латиницы красным цветом шрифта

Откройте редактор Visual Basic сочетанием клавиш ALT+F11 или в старых версиях Excel - через меню Сервис - Макрос - Редактор Visual Basic (Tools - Macro - Visual Basic Editor), вставьте новый модуль (меню Insert - Module) и скопируйте туда текст этого макроса:

Sub ShowLatin()    
For Each c In Selection        
    For i = 1 To Len(c)            
        If (Asc(Mid(c, i, 1)) >= 65 And Asc(Mid(c, i, 1)) <= 90) Or _
               (Asc(Mid(c, i, 1)) >= 97 And Asc(Mid(c, i, 1)) <= 122) Then
                c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3            
        End If        
    Next i
Next c
End Sub

Закройте редактор Visual Basic и вернитесь в Excel. Если теперь выделить интересующий диапазон ячеек (только не весь столбец или лист - а то считать до конца дня будет!) и запустить наш макрос с помощью сочетания клавиш ALT+F8 или через меню Сервис - Макрос - Макросы (Tools - Macro - Macros), то символы латиницы выделятся красным цветом шрифта:

latin3.png

Ссылки по теме


28.07.2013 19:12:22
35 тыс. просмотров и ни одного комментария. Или все понятно, или - ничего :)
MCH
17.09.2013 21:13:55
Function IsLatin(txt As String) As Boolean
    IsLatin = txt Like "*[A-Za-z]*"
End Function


Sub ShowLatin()
    Dim c As Range, i As Long
    For Each c In Selection
        For i = 1 To Len(c)
            If Mid$(c, i, 1) Like "[A-Za-z]" Then c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
    Next i, c
End Sub
21.09.2013 15:36:23
Браво! Очередное доказательство, что нет предела совершенству! :)
08.10.2013 16:27:56
...А если задача обратная, в ячейке с латиницей искать русские буквы, как код меняется, не могу сообразить...
Хотя вопрос снимаю, спс МСН!!!
09.10.2013 08:47:38
Очевидно:
Function IsRus(txt As String) As Boolean
    IsLatin = txt Like "*[А-Яа-я]*"
End Function
14.10.2014 10:03:52
Только для полной точности и универсальности не мешает ещё учесть, что буквы ё и Ё в таблице кодов стоят отдельно от всего алфавита и потому в последовательности [А-Яа-я] не входят :)
Поэтому, чтобы уж наверняка функция вылавливала кириллицу, нужно писать [А-Яа-яЁё]
28.07.2017 15:12:43
Очевидно:
Function IsRus(txt As String) As Boolean
IsLatin = txt Like "*[А-Яа-я]*"
End Function
Долой IsLatin!
Function IsRus(txt As String) As Boolean 
    IsRus = txt Like "*[А-Яа-я]*" 
End Function
 
05.11.2019 09:56:49
А можно добавить условие в один из указанных макросов: например, чтобы выделение происходило только если латинских символов больше 1?

Пример:
S27      - не нужно выделять

UTP     - нужно выделить.
27.05.2023 15:21:47
Подобная проблема возникает чаще в MS Word, при редактировании текста, надо убрать лишние пробелы и выделить латиницу, например: курсивом
Rem Выделение латинских слов в фрагменте документа
Rem подчеркиванием, полужирным или курсивом.

Public Sub MAIN()
   Dim sw$ ' Текущее слово
   Dim fc$ ' Первая буква слова

   If WordBasic.CmpBookmarks("\StartOfSel", "\EndOfSel";) = 0 Then
       WordBasic.MsgBox "Не выделен фрагмент текста.", _
       "Выделить латинские", 16
       GoTo bye
   End If
   WordBasic.CopyBookmark "\EndOfSel", "EndSel"
   WordBasic.WW7_EditGoTo "\StartOfSel"
   WordBasic.BeginDialog 300, 136, "Выделить латинские"
       WordBasic.GroupBox 9, 31, 173, 83, "Выделение"
       WordBasic.OKButton 194, 52, 88, 21
       WordBasic.CancelButton 194, 91, 88, 21
       WordBasic.OptionGroup "OptionGroup1"
           WordBasic.OptionButton 17, 52, 159, 16, "подчеркиванием"
           WordBasic.OptionButton 17, 69, 145, 16, "полужирным"
           WordBasic.OptionButton 17, 86, 128, 16, "курсивом"
   WordBasic.EndDialog

   Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
   On Error GoTo -1: On Error GoTo bye
   WordBasic.Dialog.UserDialog dlg
   While WordBasic.CmpBookmarks("\Sel", "EndSel";) <> 0
       WordBasic.SelectCurWord
       sw$ = WordBasic.[Selection$]()
       fc$ = Mid(sw$, 1, 1)
       If fc$ >= "A" And fc$ <= "z" Then
           Select Case dlg.OptionGroup1
               Case 0
                   If WordBasic.Underline() <> 1 Then WordBasic.Underline
               Case 1
                   If WordBasic.Bold() <> 1 Then WordBasic.Bold
               Case 2
                   If WordBasic.Italic() <> 1 Then WordBasic.Italic
           End Select
       End If
       WordBasic.WordRight
   Wend
bye:
End Sub


= = = или
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Color = wdColorRed
With Selection.Find
 .Text = "[a-zA-Z]"
 .Replacement.Text = ""
 .Forward = True
 .Wrap = wdFindContinue
 .Format = True
 .MatchCase = False
 .MatchWholeWord = False
 .MatchAllWordForms = False
 .MatchSoundsLike = False
 .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

так было в Word2003
Добавить или удалить лишние пробелы:

Rem Макрокоманда удаляет ненужные и добавляет необходимые
Rem пробелы в документ. Удаление ненужных символов и добавление
Rem недостающих выполняется непосредственно в документе.

Public Sub MAIN()
Dim msg$
Dim tm
Dim r
   Dim c$ ' символ на котором стоит курсор
   Dim p$ ' предыдущий символ
   If WordBasic.CmpBookmarks("\StartOfSel", "\EndOfSel";) = 0 Then
       WordBasic.CopyBookmark "\StartOfDoc", "StartSelection"
       WordBasic.CopyBookmark "\EndOfDoc", "EndSelection"
       msg$ = "Фрагмент документа не выделен." + _
               Chr(13) + "Обработка всего документа?"
       tm = 33
       
   Else
       WordBasic.CopyBookmark "\StartOfSel", "StartSelection"
       WordBasic.CopyBookmark "\EndOfSel", "EndSelection"
       msg$ = "Обработка выделеного" + Chr(13) + "фрагмента документа."
       tm = 65
   End If

   r = WordBasic.MsgBox(msg$, "Удалить-добавить пробелы", tm)
   If r = 0 Then GoTo bye
   WordBasic.WW7_EditGoTo "StartSelection"
   WordBasic.PrintStatusBar "Обработка документа ....."
   p$ = " "
   While WordBasic.CmpBookmarks("\Sel", "EndSelection";) <> 0
       c$ = WordBasic.[Selection$]()
       Select Case c$
           Case " " ' текущий символ - пробел
               If p$ = " " Or p$ = "(" Then
                   WordBasic.WW6_EditClear ' удалить ТЕКУЩИЙ символ
                   WordBasic.CharLeft
               End If

           Case ".", ",", ";", ":", "!", "?", Chr(13), Chr(9), ";)"
               If p$ = " " Then WordBasic.WW6_EditClear -1 ' удалить ПРЕДЫДУЩИЙ символ
           Case "("
               If p$ <> " " Then WordBasic.Insert " "
           Case ";)"
               If p$ = " " Then WordBasic.WW6_EditClear -1
           Case Else ' все остальные символы
               If p$ = "." Or p$ = "," Or p$ = ":" Or p$ = ";" Or p$ = "!" Or p$ = "?" Or p$ = ";)" Then WordBasic.Insert " "
       End Select
       p$ = WordBasic.[Selection$]()
       WordBasic.CharRight
   Wend
   WordBasic.PrintStatusBar "Обработка документа выполнена!"
bye:
End Sub
а ещё

'Интуитивные закладки
'**************************************************
'Макрос позволяет создавать интуитивные закладки
'Date:  16 апреля, 1998 года
'Name:  Владимир ПОЛЯКОВ
'Summary:
'***************************************************
'Ой где был я вчера!
Public Sub MAIN()
WordBasic.EditBookmark Name:="ОйГдеБылЯВчера", Add:=1
End Sub


Был бы премного благодарен, если бы их смогли бы причесать под современный VBA
10.04.2015 18:15:53
Способ 2. Функция IsLatin на VBA - шикарен!!!
Спасибо!
19.04.2015 13:08:51
Спасибо!) Функция IsLatin пригодилась.
30.06.2015 04:11:36
Здравствуйте, почему-то Способ 3 не работает (( Подсвечивает красным и кириллицу и латиницу.
30.06.2015 04:17:41
Взяла макрос из комментария - заработал. Спасибо
23.09.2015 13:32:39
Здравствуйте, коллеги! Как модернизировать функцию IsLatin , чтобы в результате получить позицию первого латинского символа в строке?
Гарнитура игровая ASUS ROG CerberusГарнитура игроваяASUS ROG Cerberus
Надо вот так разделить.
Спасибо заранее.
23.09.2015 18:13:03
Александр, для определения позиции первой английской буквы в строке можно использовать следующую формулу массива:
=ПОИСКПОЗ(1;(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА(1:10);1)))>=65)*(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА(1:10);1)))<=90);0)
Предполагается, что проверяемый текст у вас в А1.
Не забудьте после ввода нажать Ctrl+Shift+Enter, т.к. это формула массива.
24.09.2015 09:28:54
Красиво. Но не могу понять идею использования СТРОКА(1:10). При копировании формулы в столбце, работает некорректно (становится СТРОКА(2:11) итд ). Да и на моем примере лучше сработало СТРОКА(1:100), при СТРОКА(1:10) выдало ошибку #Н/Д. Спасибо.
24.09.2015 21:00:01
Да, вы правы, лучше так:
=ПОИСКПОЗ(1;(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА($1:$100);1)))>=65)*(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА($1:$100);1)))<=90);0)
25.09.2015 09:35:17
Большое спасибо.
oak
09.02.2016 11:28:48
Есть сервис, покажет цветом где какой символ http://cyr-lat.progresssite.pro/
02.02.2017 16:50:32
помогите плиз мне надо выделить в ячейке с русскими словами английские слова и в дальнейшем их удалить с помощью плекс
02.02.2017 17:07:04
Вам надо удалить целиком ячейки (строки) с английским текстом или именно английские символы, оставив остальное содержимое ячейки?
03.02.2017 06:24:48
второе, мне надо удалить именно англ символы, оставив остальное содержимое ячейки!
03.02.2017 09:15:57
Костя, для удаления латиницы можно использовать макрос подсветки красным, но чуть-чуть модернизированный:
Sub Delete_Latin()
    Dim c As Range, i As Long
    For Each c In Selection
        For i = Len(c) To 1 Step -1
            If Mid$(c, i, 1) Like "[A-Za-z]" Then c.Characters(Start:=i, Length:=1).Delete
        Next i
    Next c
End Sub

Выделяете диапазон ячеек и запускаете его - удалит все символы латиницы, остальное не тронет :)
03.02.2017 15:07:14
а в самом Плекс реализована эта идея ?
03.02.2017 18:57:10
Нет, но добавить стоит, наверное.
03.02.2017 23:00:15
  • Было б  очень удобно если б реализовали эту настройку. И наоборот удалить русские символы в англ слове.
20.04.2017 11:45:41
Добрый день.
Подскажите пожалуйста,  как с помощью способа № 3 выделить кириллицу?
22.04.2017 10:20:43
Как-то так:
Sub ShowLatin()
    Dim c As Range, i As Long
    For Each c In Selection
        For i = 1 To Len(c)
            If Mid$(c, i, 1) Like "[А-Яа-яЁё]" Then c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
    Next i, c
End Sub
13.06.2017 14:35:52
Помогите, пжл, с похожим вопросом. Нужно из ячейки выбрать русский текст и вернуть его в соседнюю ячейку. То есть из исходной информации убрать латиницу, цифры знаки и пробелы.
14.06.2017 19:22:35
Добрый вечер.
Подскажите пожалуйста, как в ячейке, в которой содержатся несколько слов на русском и на английском языках заменить в русских словах английские буквы на русские, а в английских словах русские буквы на английские.
27.06.2017 17:12:49
Здравствуйте! А как измениться макрос, если мы хотим заменить, к примеру, случайным образом английские буквы на похожие русские, или же наоборот?
Т.е. чтобы не все буквы менялись, а только некоторые из них :)
07.07.2017 10:35:29
Подскажите, пожалуйста, есть ли возможность отличить пробел русской и английской раскладок средствами экселя?
19.02.2019 18:46:45
СПАСИБО! Очень помогло! Сделала похожий скрипт, но с поиском русских символов. :like:
28.05.2019 09:21:50
Спасибо за отличные идеи. Проблема была в поиске кирилицы на английской ОС без русского языка. Пришлось идти от обратного, сначала выледяется весь текст красным и затем делается поиск латиницы с выделением черным цветом. Так и получил Подсветку кириллицы красным))))
03.09.2019 14:54:58
Подскажите пожалуйста как находить в столбце вот такоие символы ?
Ö
Ä
Ü
Ò
Ë
Есть список из 2500 слов и попадаються слова с такими символами... на пример
HÜCO
MALÒ
Flösser
идеально было бы ... такой макрос что бы из 2500 остались только те слова где есть не русские и не английские буквы.. кроме тех букв что я написал выше могут быть и другие...
23.10.2019 09:37:43
А как указать ячейки в которых есть отдельные слова, содержащие в себе одновременно и латинские и киррилические символы?

UPDATE:
Разобрался)


Function IsLatin(txt As String) As Boolean
   IsLatin = txt Like "*[A-Za-z][А-Яа-яЁё]*" Or txt Like "*[А-Яа-яЁё][A-Za-z]*"
   
End Function
24.11.2019 12:59:08
Спасибо за инструкцию! Подскажите, а как будет выглядеть код по 3-му способу, если стоит задача не выделять отдельные латинские буквы красным шрифтом, а залить ячейку, содержащую латинский символ, определенным цветом (например, желтым)?
24.11.2019 13:42:13
Добавьте в книгу функцию IsLatin, а потом используйте её в правиле условного форматирования.
Главная - Условное форматирование - Создать правило - Использовать формулу для определения форматируемых ячеек
и ввести
=IsLatin(адрес первой ячейки выделенного диапазона данных без долларов)
Затем нажать кнопку Формат и на вкладке Заливка выбрать цвет.
24.11.2019 13:46:50
Николай,

Спасибо за ответ! А в код макроса эти шаги можно как-то зашить? Чтобы на выходе мы могли просто выделить проверяемый диапазон, применить макрос и все было сразу подсвечено.
12.12.2019 10:15:57
Здравствуйте, коллеги. Подскажите пожалуйста, как отделить латинские слова с цифрами и символами от китайских?. К примеру..

4|3|穆库扎尼干红葡萄酒 Symbol of Georgia-"Mukuzani" red dry|鲜葡萄酿造|12%VOL|佐餐酒|2017|格鲁吉亚 GEORGIA|科瓦雷利酒窖有限公司  KVARELI CELLAR LTD|萨别拉维 Saperavi|0.75L*12瓶/箱
05.08.2020 13:56:16
Спасибо за готовое решение
Приветствую! Статья помогла найти разные записи автомобильных номеров, но..
Их бы теперь привести к единому стандарту. Поскольку данные тянутся при помощи Power Query, имеет смысл менять их при помощи PQ.
Очевидный вариант - замена при помощи вспомогательного списка сопоставлений. Таких вариантов несколько.
А есть ещё какие-то варианты?
12.05.2021 13:55:17
С макросом запарно, я так сделал:
=ЕСЛИ(UNICODE(C2)>=1000;"RU";"ENG")
Не знаю на счёт 1000 - тут нужно ещё экспериментировать со всеми символами, но в моём случае это сработало.
18.05.2021 17:17:42
Николай, добрый день, читаю вашу книгу "Скульптор данных в Excel в Power Qwery" подскажите в ней не реализовано через язык "М" замена символов латиницы на русский? Спасибо.
23.05.2022 11:25:05
А как казахский язык подсветить? помогите пожалуйста
24.05.2022 08:41:49
В смысле? А разве в казахском не те же (частично) символы, что и в русском? Как их отличить?
24.05.2022 13:30:56
нет там есть специфические буквы әіңғүұқөһӘІҢҒҮҰҚӨҺ.
Остальные буквы из русского алфавита. Бывает в документах на казахском языке данные и когда менеджеры вводят их- переводят шрифты на разные языки, включая иной раз и англ. Получается месиво
22.02.2023 20:34:10
Адаптировал соответствующий макрос для Word:

Sub FindLatinInSelection()
    Dim rng As Range
    Dim MyLetter As Range
    Set rng = Selection.Range
    pos1 = Selection.Start
    pos2 = Selection.End
    length1 = pos2 - pos1
    'общее количество символов в выделенном диапазоне

    For i = 0 To length1 - 1
        Set MyLetter = ActiveDocument.Range(Start:=pos1 + i, End:=pos1 + i + 1)
        'выделение диапазона типа Range, включающего в себя очередной символ в выделенном тексте
        
        'проверка диапазона с символом на наличие латинских букв
        If MyLetter Like "[A-Za-z]" Then MyLetter.Font.ColorIndex = 2
        'латинские буквы окрашиваются в синий цвет
            
        If MyLetter Like "[А-Яа-я]" Then MyLetter.Font.ColorIndex = 6
        'русские буквы (кириллица) окрашиваются в красный цвет
    Next i
End Sub
Наверх