Поиск символов латиницы в русском тексте
Одна из типовых ситуаций, с которой все мы однажды сталкиваемся: кто-то (возможно даже мы сами) при наборе текстовой информации в ячейку, случайно использовал английские буквы (латиницу) вместо русских (кириллицы). Допустить такую ошибку достаточно легко, особенно если учесть изощренное расположение некоторых символов в стандартной раскладке клавиатуры. Ну какому идиоту, скажите мне, пришло в голову помещать на одну клавишу две одинаковых по написанию буквы (английская "си" и русская "эс")? Да и с другими символами не лучше. Но, как говорится, "фарш невозможно провернуть назад" - текущая раскладка давно стала стандартом и никуда от этого не деться.
Использование символов латиницы в русском тексте порождает огромное количество проблем. От путаницы при банальной сортировке по алфавиту до некорректной консолидации данных при автоматическом объединении нескольких таблиц в одну.
Выискивать похожие по виду символы и проверять не являются ли они символами английской раскладки крайне муторно. Поэтому поищем более изящные варианты...
Способ 1. Шрифт без кириллицы
Выделите диапазон ячеек с проверяемым текстом и временно установите для него любой шрифт не содержащий кириллицу, например Albertus или любой аналогичный (находится методом тыка). Внешний вид символов кириллицы и латиницы станет отличаться и можно будет легко визуально локализовать некорректные символы:
Способ 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):
Способ 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), то символы латиницы выделятся красным цветом шрифта:
Ссылки по теме
- Подсветка латиницы с помощью надстройки PLEX
- Что такое макросы, куда вставлять код макроса, как их использовать
Хотя вопрос снимаю, спс МСН!!!
Поэтому, чтобы уж наверняка функция вылавливала кириллицу, нужно писать [А-Яа-яЁё]
Function IsRus(txt As String) As Boolean
IsLatin = txt Like "*[А-Яа-я]*"
End Function
Пример:
S27 - не нужно выделять
UTP - нужно выделить.
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
Спасибо!
Спасибо заранее.
=ПОИСКПОЗ(1;(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА(1:10);1)))>=65)*(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА(1:10);1)))<=90);0)
Предполагается, что проверяемый текст у вас в А1.
Не забудьте после ввода нажать Ctrl+Shift+Enter, т.к. это формула массива.
=ПОИСКПОЗ(1;(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА($1:$100);1)))>=65)*(КОДСИМВ(ПРОПИСН(ПСТР(A1;СТРОКА($1:$100);1)))<=90);0)
Выделяете диапазон ячеек и запускаете его - удалит все символы латиницы, остальное не тронет
Подскажите пожалуйста, как с помощью способа № 3 выделить кириллицу?
Подскажите пожалуйста, как в ячейке, в которой содержатся несколько слов на русском и на английском языках заменить в русских словах английские буквы на русские, а в английских словах русские буквы на английские.
Т.е. чтобы не все буквы менялись, а только некоторые из них
UPDATE:
Разобрался)
Function IsLatin(txt As String) As Boolean
IsLatin = txt Like "*[A-Za-z][А-Яа-яЁё]*" Or txt Like "*[А-Яа-яЁё][A-Za-z]*"
End Function
Главная - Условное форматирование - Создать правило - Использовать формулу для определения форматируемых ячеек
и ввести
Спасибо за ответ! А в код макроса эти шаги можно как-то зашить? Чтобы на выходе мы могли просто выделить проверяемый диапазон, применить макрос и все было сразу подсвечено.
4|3|穆库扎尼干红葡萄酒 Symbol of Georgia-"Mukuzani" red dry|鲜葡萄酿造|12%VOL|佐餐酒|2017|格鲁吉亚 GEORGIA|科瓦雷利酒窖有限公司 KVARELI CELLAR LTD|萨别拉维 Saperavi|0.75L*12瓶/箱
Их бы теперь привести к единому стандарту. Поскольку данные тянутся при помощи Power Query, имеет смысл менять их при помощи PQ.
Очевидный вариант - замена при помощи вспомогательного списка сопоставлений. Таких вариантов несколько.
А есть ещё какие-то варианты?
=ЕСЛИ(UNICODE(C2)>=1000;"RU";"ENG")
Не знаю на счёт 1000 - тут нужно ещё экспериментировать со всеми символами, но в моём случае это сработало.
Остальные буквы из русского алфавита. Бывает в документах на казахском языке данные и когда менеджеры вводят их- переводят шрифты на разные языки, включая иной раз и англ. Получается месиво