Function КИР_ЛАТ(СЛОВО$) As String
Dim i As Long, strTmp$, FirstS, NextS$
strTmp = Left(СЛОВО, 1)
On Error Resume Next
For i = 1 To Len(СЛОВО)
FirstS = Mid(СЛОВО, i, 1)
NextS = Mid(СЛОВО, i + 1, 1)
Select Case Asc(FirstS)
Case 65 To 90, 97 To 122
Select Case Asc(NextS)
Case 65 To 90, 97 To 122
strTmp = strTmp & NextS
Case Else
strTmp = strTmp & " " & NextS
End Select
Case 192 To 255, 168, 184
Select Case Asc(NextS)
Case 192 To 255, 168, 184
strTmp = strTmp & NextS
Case 65 To 90, 97 To 122
strTmp = strTmp & " " & NextS
Case Else
strTmp = strTmp & " " & NextS
End Select
Case Else
strTmp = strTmp & " " & NextS
End Select
Next i
КИР_ЛАТ = strTmp
End Function

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