Trouver valeur dernière ligne et mise en forme

Bonjour à tous,

J'aimerais créer une macro qui applique une mise en forme à toutes les cellules d'une colonne en fonction de la dernière cellule non-vide de cette même colonne.

J'ai créé ça mais ça ne fonctionne pas quand je l'exécute, rien ne se passe, pourriez-vous m'éclairer ? Merci

Dim Total As Long

Total = Range("P65536").End(xlUp).Value

Range("P2:P200").Select

Dim cell As Variant

For Each cell In Selection

If cell.Value < Total Then

cell.Font.Color = RGB(196, 10, 10)

End If

Next

Bonjour,

Essaie ce code :

Sub test()
'Macro Dan le 28/08/12
Dim cel As Range
Dim dlg As Long
dlg = Range("P" & Rows.Count).End(xlUp).Row

For Each cel In Range("P2:P" & dlg)
    If cel.Value < Range("P" & dlg).Value Then
        cel.Font.Color = RGB(196, 10, 10)
    Else: cel.Font.Color = Range("P" & dlg).Font.Color
    End If
Next
End Sub

Si ok, lors de ta réponse merci de cloturer le fil en cliquant sur le V vert à coté du bouton EDITER

Amicalement

Bonjour

Code à recopier :

Public Sub Format_Cellules()

Dim Cellule As Range

With ActiveSheet

.Cells(16, 1).Select 'Colonne P

.Range(Selection, Selection.End(xlDown)).Select

End With

For Each Cellule In Selection

Cellule.Font.Color = RGB(196, 10, 10)

Next

End Sub

Cordialement

Merci à vous c'est parfait !

Je continue sur ce thread pour ne pas en ouvrir un nouveau.

Je me suis basé sur le code que m'a envoyé Dan et je l'ai rapidement adapté afin que dans ma colonne P seules les valeurs inférieures à 0.8*valeur de la dernière ligne se mettent en rouge (et les valeurs supérieures à 1.2*valeur de la dernière ligne en vert, pas de changements sinon).

Dans le code suivant ça m'indique un pb à la 6ème ligne (incomptabilité de type) mais je ne parviens pas à le résoudre. Encore une petite aide de dispo ? Merci

Dim cel As Range

Dim dlg As Long

dlg = Range("P" & Rows.Count).End(xlUp).Row

For Each cel In Range("P2:P" & dlg)

If cel.Value <> Range("P" & dlg).Value Then

If cel.Value < 0.8 * Range("P" & dlg).Value Then

cel.Font.Color = RGB(179, 0, 0)

Else:

If cel.Value > 1.2 * Range("P" & dlg).Value Then

cel.Font.Color = RGB(0, 104, 0)

Else:

cel.Font.Color = Range("P" & dlg).Font.Color

End If

End If

Else: cel.Font.Color = Range("P" & dlg).Font.Color

End If

Next

RE,

J'ai réouvert le fil (pour ouvrir un fil cloturé clique sur le V devenu rouge)

Pour ton souci, faudrait voir ton fichier

Lorsque tu parles de la ligne 6 c'est celle-ci ? --> If cel.Value < 0.8 * Range("P" & dlg).Value Then

A te relire

Oui c'est bien celle-ci

re

Je viens de m'aperçevoir d'une chose

cel.Value < 0.8 * Range("P" & dlg).Value

Tu as un opérateur de multiplication entre le 0.8 et Range, pourquoi ???

Que cherches tu à faire exactement ?

Je voudrais que les cellules se mettent en rouge (ou plutôt la police de leur contenu) lorsque l'on rencontre une valeur inférieure à 80% de la valeur de la dernière ligne, d'où l'opérateur de multiplication. Je vois que ça cause le problème mais je ne vois pas comment faire.

Bonjour,

Recopier code:

Option Explicit
Public Sub Format_Cellules()

Dim Cellule As Range
Dim Plage As Range
Dim derLigne As Range
Dim i As Double

    With ActiveSheet
        .Cells(2, 1).Select
        Set Plage = Range(Selection, Selection.End(xlDown))
        Set derLigne = Selection.End(xlDown)
    End With

    For Each Cellule In Plage

        i = Cellule / derLigne

        Select Case i
            Case Is < 0.8
                Cellule.Font.Color = RGB(179, 0, 0)
            Case Else
                Cellule.Font.Color = RGB(0, 104, 0)
        End Select

    Next

    Set Plage = Nothing
    Set derLigne = Nothing

End Sub

Jean-Eric

Re,

Je ne vois pas à priori ce qui cloche dans ce que tu as donné. Il faudrait voir ton fichier pour vérifier

Sinon par rapport à ton code essaie aussi ceci :

Dim cel As Range
Dim dlg As Long

dlg = Range("P" & Rows.Count).End(xlUp).Row

For Each cel In Range("P2:P" & dlg)
    If cel.Value <> Range("P" & dlg).Value Then
        If cel.Value < 0.8 * Range("P" & dlg).Value Then
            cel.Font.Color = RGB(179, 0, 0)
        ElseIf cel.Value > 1.2 * Range("P" & dlg).Value Then
            cel.Font.Color = RGB(0, 104, 0)
        Else: cel.Font.Color = Range("P" & dlg).Font.Color
        End If
    Else: cel.Font.Color = Range("P" & dlg).Font.Color
    End If
Next

ou plus lisible et dans le même esprit que le code de Jean Eric

Dim cel As Range
Dim dlg As Long

dlg = Range("P" & Rows.Count).End(xlUp).Row

For Each cel In Range("P2:P" & dlg)
    If cel.Value <> Range("P" & dlg).Value Then
        Select Case cel
        Case Is < 0.8 * Range("P" & dlg).Value: cel.Font.Color = RGB(179, 0, 0)
        Case Is > 1.2 * Range("P" & dlg).Value: cel.Font.Color = RGB(0, 104, 0)
        Case Else: cel.Font.Color = Range("P" & dlg).Font.Color
        End Select
    End If
Next

Amicalement