Sub TestShowInstr()
FnShowInstr ActiveCell, "sva"
End Sub
Function FnShowInstr_1(ByVal rCell As Range, _
ByVal strFind As String)
j = InStr(1, rCell.Value, strFind, vbTextCompare)
With rCell
.Characters(Start:=j, Length:=Len(strFind)).Font.ColorIndex = 3
.Characters(Start:=j, Length:=Len(strFind)).Font.Bold = True
End With
End Function
Function FnShowInstr(ByVal rCell As Range, _
ByVal strFind As String)
Dim strMain As String:
Dim iLenFind As Integer, iLenMainFind As Integer
'все в верхний регистр
strFind = UCase(strFind)
strMain = UCase(rCell.Value) '
iLenMainFind = Len(strMain) 'длина строки
iLenFind = Len(strFind) 'длина строки поиска
If InStr(1, strMain, strFind, vbTextCompare) Then 'если есть в слове, то перебирам все символы
For i = 1 To iLenMainFind
strFind = UCase(strFind)
strFindMain = Mid(strMain, i, iLenFind)
If strFindMain = strFind Then
With rCell
.Characters(Start:=i, Length:=iLenFind).Font.ColorIndex = 3
.Characters(Start:=i, Length:=iLenFind).Font.Bold = True
End With
End If
Next i
End If 'InStr(1, strMain, strFind, vbTextCompare)
' With rCell
' .Characters(Start:=j, Length:=Len(strFind)).Font.ColorIndex = 3
' .Characters(Start:=j, Length:=Len(strFind)).Font.Bold = True
' End With
End Function
''Sub ShowLatin()
'' 'moonexcel.com.ua
'''http://moonexcel.com.ua/поиск-латинских-букв-в-тексте_ru
'' 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
''
''Sub ShowCyrylic()
'' 'moonexcel.com.ua
'' Dim c As Range, i As Long
'' NbCol = ActiveSheet.Cells(1, 256).End(xlToLeft).Column + 2
'' NbRow = ActiveSheet.Cells(65536, 1).End(xlUp).row
'' For Each c In Selection
'' Cells(c.row, NbCol) = ""
'' For i = 1 To Len(c)
'' If Mid$(c, i, 1) Like "[а-яё,А-ЯЁ]" Then
'' c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
'' If Len(Cells(c.row, NbCol)) > 0 Then
'' ff = Mid$(c, i, 1)
'' Cells(c.row, NbCol) = Cells(c.row, NbCol) & "," & Mid$(c, i, 1)
'' Else
'' Cells(c.row, NbCol) = Mid$(c, i, 1)
'' End If
'' End If
'' Next i, c
''End Sub
''
''Sub ShowCyrylic1()
'' 'moonexcel.com.ua
'' 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
