Dragă Justin,
Îmi pare rău pentru asta. După lipirea codului VBA în fereastra Cod, vă rugăm să apăsați tasta F5 pentru a rula codul, apoi se va deschide caseta de dialog „Kutools for Excel”. Mulțumesc.

Bună,
Îmi pare rău, nu te pot ajuta cu asta. Multumesc pentru comentariul tau.

Salut PAUC,
Următorul cod vă poate face o favoare. Vă rugăm să încercați.

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

Salut Andreea,
Dacă doriți să evidențiați cuvântul doar dacă este la începutul celulelor selectate. Următorul cod VBA vă poate face o favoare. Vă rugăm să încercați.

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

Salut Ciao,
Numerele dvs. sunt situate în celule diferite dintr-un interval? Dacă da, puteți crea două reguli de formatare condiționată (între -10 și 0, între 0 și 10) pentru a evidenția aceste numere. Dacă nu, puteți încărca o captură de ecran a datelor dvs.?

Bună t.taln,

Dacă doriți să măriți dimensiunea fontului cu 1 și să evidențiați mai multe cuvinte în același timp, vă rugăm să adăugați următoarea linie după linia "xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3" în codul VBA.
notițe: Trebuie să cunoașteți în prealabil dimensiunea fontului curent al celulei selectate și apoi să introduceți un număr cu o dimensiune mai mare decât cuvântul original. Numărul 12 din rândul de mai jos este dimensiunea fontului pe care o voi atribui cuvintelor care se potrivesc. Și dimensiunea originală a fontului cuvântului este 11.

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

Bună Shaik Faiaz hamad,

Excel nu permite colorarea unei părți a unei celule. Îmi pare rău că nu te pot ajuta cu această problemă.

Buna Cous,

Următorul cod VBA vă poate ajuta. După rularea codului, veți primi o casetă de dialog. Introduceți cuvintele pe care doriți să le evidențiați și separați-le prin virgulă.

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