[Résolu] Compter les écarts entre 2 zones de couleurs définies

[apnart]

Bonjour,

J'ai un tableau avec diverses zones de couleurs (c'est un planning et les couleurs représentent des congés, astreintes, formations,... bref, plusieurs couleurs).

Je souhaite compter le nombre de cellules d'une certaine couleur. Ca c'est bon, grâce au forum, depuis longtemps, j'ai la p'tite fonction qui va bien.

Mais je souhaite aussi, et c'est là que je n'ai pas la solution, compter sur 1 ligne, le nombre de fois où j'ai moins de 15 cellules entre 2 cellules d'une couleur définie.

Dans mon fichier d'exemple attaché :

Ligne 2 : j'ai 3 zones jaunes espacées de 15 cellules (colorées en autre chose ou sans couleurs, avec ou sans texte)
En colonne AZ je compte les cases jaunes, et j'en ai 15
En colonne BA, je voudrais qu'une formule puisse me donner "0"

Ligne 2 : j'ai 3 zones jaunes, dont l'espace entre la 2ème et la 3ème n'est que de 14 cases... en BA je voudrais donc lire 1

... l'exemple devrait parler de lui même.

A noter que pour l'exemple j'ai 3 zones jaunes, mais je peux en avoir bien plus.

Des idées sur comment procéder ? Faire une fonction (laquelle) ?

Merci de votre aide,
Bruno.

 

[homepyrof53]

Re : Compter les écarts entre 2 zones de couleurs définies

Bonjour,

Voici la fonction qui a les mêmes arguments que somsouleur

Function NbEcart(Zne As Range, CaseRef As Range) As Integer
Dim CouleurInterieure As String
    Application.Volatile True
    CouleurInterieure = CaseRef.Interior.ColorIndex
    Dim NBdif, Dif
    For Each cell In Zne
       If cell.Interior.ColorIndex = CouleurInterieure Then
            If Dif > 0 And Dif < 15 Then
                NBdif = NBdif + 1
            End If
                Dif = 0
                Else
            Dif = Dif + 1
        End If
    Next cell
NbEcart = NBdif
End Function

 

[apnart]

Re : Compter les écarts entre 2 zones de couleurs définies

MERCI !

C'est parfait, j'ai juste complété avec la possibilité de changer le "15"


Je cherchais à faire un truc avec plein de boucle... alors que ta solution est lympide... PARFAIT !

Bruno.

Function NbEcart(CaseRef As Range, Zne As Range, Cpt As Integer) As Integer
Dim CouleurInterieure As String
    Application.Volatile True
    CouleurInterieure = CaseRef.Interior.ColorIndex
    Dim NBdif, Dif
    For Each cell In Zne
       If cell.Interior.ColorIndex = CouleurInterieure Then
            If Dif > 0 And Dif < Cpt Then
                NBdif = NBdif + 1
            End If
                Dif = 0
                Else
            Dif = Dif + 1
        End If
    Next cell
NbEcart = NBdif
End Function

 

[apnart]

Re : Compter les écarts entre 2 zones de couleurs définies

Bonjour,

J'ai à nouveau un soucis avec ce code, je ne l'avais pas détecté avec mon exemple, mais maintenant que j'essaies de mettre ça en prod, je découvre un cas que je n'avais pas vu avant...

Dans mes exemples précédents, ma zone de recherche commençait par la couleur en question, mais si ce n'est pas le cas, le résultat n'est plus bon.

Voir l'exemple attaché.

Nom5 : le résultat devrait être 1 pour l'écart alors qu'il me donne 2 (je n'ai qu'1 écart de mois de 15 cases entre 2 zones jaunes).

Le pb est dans la boucle qui commence à incrémenter la variable "Dif", mais je ne trouve pas comment changer.

Des idées ?
Merci d'avance

 

[apnart]

Re : [Nouveau soucis] Compter les écarts entre 2 zones de couleurs définies

re,

j'ai modifié le code comme suit :

Function NbEcart(Zne As Range, CoulRef As Range, Cpt As Integer) As IntegerDim CouleurInterieure As String


    Application.Volatile True
    CouleurInterieure = CoulRef.Interior.ColorIndex
    
    Dim NBdif As Integer
    Dim Dif As Integer
    Dim CoulVue As Integer
    
    NBdif = 0
    Dif = 0
    CoulVue = 0
    
    For Each cell In Zne
       If cell.Interior.ColorIndex = CouleurInterieure Then
            CoulVue = 1
            If Dif > 0 And Dif < Cpt Then
                NBdif = NBdif + 1
            End If
            Dif = 0
        Else
            If CoulVue = 0 Then
                Dif = 0
            Else
                Dif = Dif + 1
            End If
        End If
    Next cell


NbEcart = NBdif
End Function

J'ai ajouté une vérification de 1ère vue de la couleur en question (variable CoulVue) et mis la variable Dif à 0 si ce n'est pas le cas.

J'ai bon ? (ça semble marcher)

 

[homepyrof53]

Re : [Nouveau soucis] Compter les écarts entre 2 zones de couleurs définies

Bonjour,
Effectivement parfois je suis un moment sans me connecter.
J'aurais fait ce que tu as fait.

Cordialement

 

[apnart]

Re : [Nouveau soucis] Compter les écarts entre 2 zones de couleurs définies

Super, merci encore !

J'ai failli tourner en bourrique pour comprendre là ou la boucle posait soucis , mais c'est comme ça qu'on avance