XL 2013 mise en surbrillance sous condition

[ANTONY34200]

Bonjour le forum,
j'ai besoin d'une petite formule afin de me permettre de mettre en surbrillance une selection de cellule comprise dans une colonne.

je m'explique.

dans la plage H5 à H35, si j'ai plus de 5 cellules non vide consécutive, j'aimerais pouvoir les mettre en surbrillance. sois par VBA soit par MFC.

Dans l'attente d'un petit coup de pouce, je vous remerci d'avance.

 

[sylvanu]

Bonjour Anthony, le forum,
Un essai en PJ avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("H1:H1000")) Is Nothing Then
         Application.ScreenUpdating = False
         [H:H].Interior.Color = xlNone
         PL = [E1].End(xlDown).Row
         DL = [E65500].End(xlUp).Row
            For L = PL To DL
                Début = L: Fin = L
                While Cells(Fin, "H") <> ""
                    Fin = Fin + 1
                Wend
                If Fin - Début >= 5 Then
                    Range(Cells(Début, "H"), Cells(Fin - 1, "H")).Interior.Color = RGB(255, 255, 0)
                    L = L + Fin - Début
                    If L > DL Then Exit Sub
                End If
            Next L
    End If
Fin:
Application.ScreenUpdating = True
End Sub

 

[ANTONY34200]

Sylvanu,
merci pour le retour.
je dois adapter le code à ma vrai feuille de calcul. a quoi corespond le L ??

 

[sylvanu]

Re,
C'est l'indice du For :

For L = PL To DL

De PL première ligne à DL dernière ligne.

 

[fanch55]

Bonjour
Fonction à mettre dans un module et à appeler via MFC :

Function NbCons(Cell As Range)
Dim I As Integer
Dim N As Integer: N = 1
Dim M As Integer: M = 4 ' Nombre mini de cellules consécutives

    If Cell <> "" Then
        For I = 1 To M
            If Cell.Offset(I) = "" Then Exit For
            N = N + 1
        Next
        For I = 1 To M
            If Cell.Offset(-I) = "" Then Exit For
            N = N + 1
        Next
    End If
    
NbCons = N > M
End Function

La fonction ci-dessous contrôle si 5 cellules consécutives ont la même valeur :

Function NbConsIdem(Cell As Range)
Dim I As Integer
Dim N As Integer: N = 1
Dim M As Integer: M = 4 ' Nombre mini de cellules consécutives

    If Cell <> "" Then
        For I = 1 To M
            If Cell.Offset(I) <> Cell Then Exit For
            N = N + 1
        Next
        For I = 1 To M
            If Cell.Offset(-I) <> Cell Then Exit For
            N = N + 1
        Next
    End If
    
NbConsIdem = N > M
End Function

 

[ANTONY34200]

Ok,
quand je copie le code dans mon fichier, j'ai un débogage ...

 

[ANTONY34200]

FANCH55,
merci du retour, je viens de tester, ça fonctionne nickel.
Merci

 

[job75]

Bonjour ANTONY34200, le fil,

Pas besoin de VBA, voyez le fichier joint avec cette MFC sur H5:H35 :

=OU(NBVAL(DECALER(H5;;;5))=5;NBVAL(DECALER(H5;-1;;5))=5;NBVAL(DECALER(H5;-2;;5))=5;NBVAL(DECALER(H5;-3;;5))=5;NBVAL(DECALER(H5;-4;;5))=5)

A+

 

[ANTONY34200]

Bonjour job75,
merci pour cette solution, jela garde sous le coude, et je pense devoir m'en servir pour un autre soucis dont vous venez certaiment de m'apporter la solution ...