Sub find_Rus() 'Поиск и выделение в выделенном диапазоне киррилических букв схожих с англицкими
Dim i As Integer
Dim s As Integer
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = Application.Selection()
Dim iCell As Range
'список русских букв
sRus = Array("е", "у", "и", "о", "р", "а", "к", "х", "с", _
"Е", "Т", "О", "Р", "А", "Н", "К", "Х", "С", "В", "М")
Application.ScreenUpdating = False  ' Запрещаем обновление экрана во время работы макроса

For i = LBound(sRus) To UBound(sRus)
Set iCell = rDoc.Find(What:=sRus(i), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True)
 
  If Not iCell Is Nothing Then
       iAddress$ = iCell.Address
          Do
            If Not iCell.HasFormula Then
               iPosition% = InStr(iCell.Value, sRus(i))
                 Do
                   iCell.Characters(Start:=iPosition, Length:=Len(sRus(i))).Font.Bold = True
                   iCell.Characters(Start:=iPosition, Length:=Len(sRus(i))).Font.Color = vbRed
                   iPosition% = InStr(iPosition% + 1, iCell.Value, sRus(i))
                   s = s + 1
                 Loop While iPosition% <> 0
            End If
            Set iCell = rDoc.FindNext(After:=iCell)
          Loop While iCell.Address <> iAddress$
  End If
Next i
Application.ScreenUpdating = True  ' Обновляем экран
MsgBox "Найдено " & s & " совпадений"
End Sub

Sub changeRusToLat() 'Замена в выделенном диапазоне киррилических букв на латинские
Dim i As Integer
Dim sLat As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = Application.Selection()
'список русских букв
sRus = Array("в", "е", "у", "и", "о", "р", "а", "к", "х", "с", _
"Е", "Т", "О", "Р", "А", "Н", "К", "Х", "С", "В", "М")
'список латинских букв
sLat = Array("b", "e", "y", "u", "o", "p", "a", "k", "x", "c", _
"E", "T", "O", "P", "A", "H", "K", "X", "C", "B", "M")

Application.ScreenUpdating = False  ' Запрещаем обновление экрана во время работы макроса
For i = LBound(sRus) To UBound(sRus)
rDoc.Replace What:=sRus(i), Replacement:=sLat(i), LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, ReplaceFormat:=False
Next i
With rDoc.Characters.Font
.ColorIndex = 1
.FontStyle = Normal
End With
Application.ScreenUpdating = True  ' Обновляем экран
MsgBox "Замена Выполнена", vbInformation
End Sub