Drogi Justinie,
Przepraszam za to. Po wklejeniu kodu VBA do okna Kod naciśnij klawisz F5, aby uruchomić kod, a następnie otworzy się okno dialogowe „Kutools for Excel”. Dziękuję Ci.

Cześć,
Przepraszam, nie mogę w tym pomóc. Dzięki za komentarz.

Witaj PAUC,
Poniższy kod może wyświadczyć ci przysługę. Proszę spróbować.

Sub HighlightStrings()
'Updated by Extendoffice 20220721
    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    On Error Resume Next
    xHStr = "apple"
    If TypeName(xHStr) <> "String" Then Exit Sub
    Application.ScreenUpdating = False
        xHStrLen = Len(xHStr)
        For Each xCell In Selection
            xArr = Split(xCell.Value, xHStr)
            xCount = UBound(xArr)
            If xCount > 0 Then
                xStrTmp = ""
                For I = 0 To xCount - 1
                    xStrTmp = xStrTmp & xArr(I)
                    xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
                    xStrTmp = xStrTmp & xHStr
                Next
            End If
        Next
    Application.ScreenUpdating = True
End Sub

Cześć Andrea,
Jeśli chcesz podświetlić słowo tylko wtedy, gdy znajduje się na początku zaznaczonych komórek. Poniższy kod VBA może ci wyświadczyć przysługę. Proszę spróbować.

Sub HighlightStrings()
'Updated by Extendoffice 20220805
    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    On Error Resume Next
    xHStr = Application.InputBox("What is the string to highlight:", "KuTools For Excel", , , , , , 2)
    If TypeName(xHStr) <> "String" Then Exit Sub
    Application.ScreenUpdating = False
        xHStrLen = Len(xHStr)
        For Each xCell In Selection
            If xHStrLen <= Len(xCell.Value) Then
                If xHStr = Left(xCell.Value, xHStrLen) Then
                    xCell.Characters(1, xHStrLen).Font.ColorIndex = 3
                End If
            End If
        Next
    Application.ScreenUpdating = True
End Sub

Cześć Ciao,
Czy Twoje liczby znajdują się w różnych komórkach w zakresie? Jeśli tak, możesz utworzyć dwie reguły formatowania warunkowego (od -10 do 0, od 0 do 10), aby wyróżnić te liczby. Jeśli nie, czy możesz przesłać zrzut ekranu swoich danych?

Cześć ttaln,

Jeśli chcesz zwiększyć rozmiar czcionki o 1 i zaznaczyć wiele słów jednocześnie, dodaj po linii następującą linię "xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3"w kodzie VBA.
Uwagi: Musisz wcześniej znać bieżący rozmiar czcionki wybranej komórki, a następnie wprowadzić numer o jeden rozmiar większy niż oryginalne słowo. Numer 12 w poniższym wierszu to rozmiar czcionki, który przypiszę pasującym słowom. Oryginalny rozmiar czcionki tego słowa to 11.

xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Size = 12

Cześć Shaik Faiaz hamad,

Excel nie pozwala na kolorowanie części komórki. Przykro mi, że nie mogę ci pomóc z tym problemem.

Cześć Kus,

Poniższy kod VBA może pomóc. Po uruchomieniu kodu pojawi się okno dialogowe. Wpisz słowa, które chcesz zaznaczyć i oddziel je przecinkami.

Sub HighlightStrings()
'Updated by Extendoffice 20230130
    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    Dim xArr2
    On Error Resume Next
    xHStr = Application.InputBox("What is the string to highlight：", "KuTools For Excel", , , , , , 2)
    If TypeName(xHStr) <> "String" Then Exit Sub
    Application.ScreenUpdating = False
    
    xArr2 = Split(xHStr, ",")
    For j = 0 To UBound(xArr2)
        xHStr = xArr2(j)
    
        xHStrLen = Len(xHStr)
        For Each xCell In Selection
            xArr = Split(xCell.Value, xHStr)
            xCount = UBound(xArr)
            If xCount > 0 Then
                xStrTmp = ""
                For I = 0 To xCount - 1
                    xStrTmp = xStrTmp & xArr(I)
                    xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
                    xStrTmp = xStrTmp & xHStr
                Next
            End If
        Next
    Next
    
    Application.ScreenUpdating = True
End Sub