code

 Option Explicit

' Excel 2002 (XP) kompatibilní
' Barví text začínající za "číslo + tečka" do světle šedé (RGB(192,192,192))
Sub ColorTextAfterNumberDot_AllMatches()
    Dim rng As Range
    Dim cel As Range
    Dim s As String
    Dim re As Object
    Dim matches As Object
    Dim m As Object
    Dim i As Long
    Dim totalLen As Long
    Dim startPos As Long
    Dim lengthPart As Long
    Dim nextFirstIndex1 As Long

    ' Použij výběr, pokud existuje, jinak celý UsedRange
    On Error Resume Next
    If TypeName(Selection) = "Range" Then Set rng = Selection
    On Error GoTo 0
    If rng Is Nothing Then Set rng = ActiveSheet.UsedRange

    ' Vytvoříme regulární výraz: hledáme "jedno nebo více číslic následované tečkou"
    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.Pattern = "\d+\."

    Application.ScreenUpdating = False

    For Each cel In rng.Cells
        If Not IsError(cel.Value) Then
            s = CStr(cel.Value)
            totalLen = Len(s)
            If totalLen > 0 Then
                Set matches = re.Execute(s)
                If matches.Count > 0 Then
                    For i = 0 To matches.Count - 1
                        Set m = matches.Item(i)
                        ' Start textu za tečkou (převod z 0-based FirstIndex na 1-based VBA index)
                        startPos = m.FirstIndex + m.Length + 1
                        If startPos > totalLen Then
                            ' nic za tečkou
                        Else
                            If i < matches.Count - 1 Then
                                ' najdi pozici dalšího čísla (převod na 1-based)
                                nextFirstIndex1 = matches.Item(i + 1).FirstIndex + 1
                                lengthPart = nextFirstIndex1 - startPos
                            Else
                                ' poslední výskyt: až do konce buňky
                                lengthPart = totalLen - startPos + 1
                            End If

                            If lengthPart > 0 Then
                                On Error Resume Next
                                cel.Characters(Start:=startPos, Length:=lengthPart).Font.Color = RGB(192, 192, 192)
                                On Error GoTo 0
                            End If
                        End If
                    Next i
                End If
            End If
        End If
    Next cel

    Application.ScreenUpdating = True
    MsgBox "Hotovo: text za každým 'číslo.' byl naformátován na světle šedou.", vbInformation, "Formát hotov"
End Sub