Trouver l'interval de cellules colorées en VBA

Bonjour,

Je suis tout nouveaux sur le forum.

J'ai le code ci-dessous, que j'ai récupéré sur internet et qui marche très bien

Function CountCcolor(range_data As range, criteria As range) As Long

    Dim datax As range
    Dim xcolor As Long

xcolor = criteria.Interior.ColorIndex
For Each datax In range_data

    If datax.Interior.ColorIndex = xcolor Then
CountCcolor = CountCcolor + 1

End If

Next datax
End Function

Il me permet de compter le nombre de cellule coloré sur une ligne coloré avec la couleur que je lui indique.

Maintenant ce que je voudrais faire, c'est un programme qui me donne l'intervalle des cellules coloré sur une ligne.

Donc de la première ligne coloré à la dernière.

Je voudrais pouvoir utiliser ce programme comme fonction personnalisée avec Application.Volatile pour qu'elle soit recalculer à chaque changement de valeur.

Voilà à quoi mon tableau doit ressembler.

Voilà je ne sait pas si c'est possible.

Si vous avez des question je me ferais un plaisir d'y répondre.

Merci ^^

Hello,

Tu veux l'utiliser comment cet interval ensuite ?

Une fonction ok mais ça doit retourner quoi ? Un range ? Un string ? un nombre de colonne ?

Est ce que tu veux savoir (dans ton exemple) de 3 à 10 ou tu veux savoir que tes couleurs se trouve entre la cellule F8 et M8 ?

tu veux faire ça sur une seule ligne ou sur un nombre inconnu de ligne ?

R@g

Bonjour,

L'idée c'est de faire un planning gantt ou la couleur représente la durée de la tache, je voudrais donc connaitre le début et la fin de cette tache et qu'il apparaisse dans mon tableau.

Je veux savoir que mes cellules coloré sont de 3 à 10. Et affiché le 3 et le 10 dans la cellule A8 et B8.

Sur un nombre inconnu de ligne il devrait y en avoir au maximum 100.

Hello,

Voici une fonction qui te donne l'interval de départ.

Combiné avec ta fonction de nombre de cellules colorées tu doit pouvoir recupérer l'interval de fin.

Fonction + utilisation dans ton exemple :

Function Calcul_Interval_Debut(Couleur_Color_Index As Long, Ligne_Recherche As Long, Ligne_Interval As Long, Colonne_Deb As Long, Colonne_Fin As Long) As Long

Dim j As Integer

j = Colonne_Deb
Do While j <= Colonne_Fin
    If Cells(Ligne_Recherche, j).Interior.ColorIndex = Couleur_Color_Index Then
        Calcul_Interval_Debut = Cells(Ligne_Interval, j).Value
        Exit Do
    End If
    j = j + 1
Loop

End Function

Utilisation dans ton exemple :

Dim i As Long

 i = Calcul_Interval_Debut(49, 8, 7, 4, 19)

MsgBox i

R@g

Bonjour,

J'ai mis un peu de temps à comprendre mais cela fonctionne très bien !

Merci beaucoup pour votre temps !