Coloration specifique

Question

Je veux colourer les numeros inferieur de 20 par meme colour dans la meme colone come ci-dessous au photo joint...

Theze · Answer

Une piste mais il y aura probablement des corrections à apporter : Sub Test() Dim Plage As Range Dim Cel As Range Dim T Dim Tbl() As Integer Dim I As Integer Dim J As Integer Dim K As Integer With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With For Each Cel In Plage T = Split(Cel.Value, ",") For I = 0 To UBound(T) J = J + Len(T(I)) + 1 If CInt(T(I)) &lt; 20 Then K = K + 1: ReDim Preserve Tbl(1 To 2, 1 To K) Tbl(1, K) = J - Len(T(I)) Tbl(2, K) = Len(T(I)) End If Next I For I = 1 To UBound(Tbl, 2) Cel.Characters(Tbl(1, I), Tbl(2, I)).Font.ColorIndex = 3 Next I Next Cel End Sub...

mbbp · Answer

Oui, mais la présentation est en noir et blanc ! Comme ceci avec une simple MFC ...

Theze · Answer

Re,

Oups, j'ai oublié de réinitialiser les variables donc, voici le code corrigé :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim T
    Dim Tbl() As Integer
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer

    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In Plage

        T = Split(Cel.Value, ",")

        For I = 0 To UBound(T)

            J = J + Len(T(I)) + 1

            If CInt(T(I)) < 20 Then

                K = K + 1: ReDim Preserve Tbl(1 To 2, 1 To K)
                Tbl(1, K) = J - Len(T(I))
                Tbl(2, K) = Len(T(I))

            End If

        Next I

        If Not Not Tbl Then

            For I = 1 To UBound(Tbl, 2): Cel.Characters(Tbl(1, I), Tbl(2, I)).Font.ColorIndex = 3: Next I

        End If

        Erase Tbl: K = 0: J = 0

    Next Cel

End Sub