MyTetra Share
Делитесь знаниями!
Закрасить симводы строки(поиск)
16.03.2019
23:43
Раздел: !Закладки - VBA

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


Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования