Excel: VBA скрипты для выделения и замены русских букв на английские

[itpro]

Оставлю тут 2 vba скрипта для документа Excel.
Первый позволяет найти и выделить разным цветом все английские и русские буквы в выделенных ячеек.
Второй заменяет русские буквы на аналогичные по написанию латинские.
ЗЫ. Скрипты мне понадобились для поиска и исправления некорректно забитых пользователеями в Excel MAC адресов. В данных пользователи путали английские и русские ьувы, вместо 0 ставил О, вместо 6 - б (Б) и т.п. В таблице было порядка 1000 записей, так что вручную это исправить было не реально.

Код: [Выделить]

Sub Color_RUS_LAT() ' Выделяет русские символы в выделенном диапазоне [color=green]ЗЕЛЁНЫМ[/color], латинские - [color=red]КРАСНЫМ[/color]
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 = 5 'цвет символов LAT
iCell.Characters(Start:=i, Length:=1).Font.ColorIndex = iColor
Next i
Next iCell
rRange.Select
Application.ScreenUpdating = True
eXXit: End Sub

Код: [Выделить]

Sub Repair_LAT() ' замена русских буквы на такие же по начертанию латинские
If TypeName(Selection) <> "Range" Then Exit Sub
Dim arrENG(): arrENG = Array("C", "0", "0", "0", "0", "c", "E", "e", "T", "O", "o", "p", "P", "A", "a", "H", "K", "k", "X", "x", "B", "M")
Dim arrRUS(): arrRUS = Array("С", "O", "o", "О", "о", "с", "Е", "е", "Т", "О", "о", "р", "Р", "А", "а", "Н", "К", "к", "Х", "х", "В", "М")
Dim i%
For i = 0 To UBound(arrENG)
Intersect(Selection, ActiveSheet.UsedRange).Replace _
What:=arrRUS(i), _
Replacement:=arrENG(i), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
Next i
End Sub