XL 2016 3 couleurs différentes

Nain porte quoi

XLDnaute Junior
Bonjour à tous,

je cherche à résoudre un problème (en VBA) qui est certainement très basique mais mon neurone ne trouve rien en cette période de confinement.
J'ai un fichier avec un certain nombre de cellule (ici 8 pour l'exemple), les 3 premières cellules doivent avoir comme couleur de fond du blanc (ou pas de couleur), ça ça va, les 2 suivantes ont une couleur de fond que je ne suis pas sensé connaitre à l'avance, mais différente de la première, et les 3 suivantes une autre couleur, donc différente des 2 premières, que je ne connais pas non plus.

La question est : comment je peux savoir en VBA que les cellules A1:A3 sont en blanc (ça ça va), les 2 suivantes sont d'une couleur différente de la première mais identiques entre elles, et les 3 dernières encore différentes des 2 premières mais identiques sur ces 3 là.

Cerise sur le gâteau, les couleurs des polices doivent être différentes des couleurs de fond (pas de police rouge sur fond rouge par exemple)

Le fichier d'exemple devrait être plus clair

Merci à ceux qui prendront le temps d'utiliser leur(s) neurone(s) :)
 

Pièces jointes

  • Classeur1.xlsx
    8.9 KB · Affichages: 18
Solution
bon
VB:
Private Type gr
    address As String
    couleur As Long
End Type


Sub test()
    Dim groupe() As gr, p As Range, C&, I&, tXt$
    Set plage = Range("A1:A20")
    C = 0
    For Each cel In plage.Cells
        If cel.Interior.Color <> C Then
            I = I + 1: ReDim Preserve groupe(1 To I)
            groupe(I).couleur = cel.Interior.Color
            groupe(I).address = cel.address
            C = cel.Interior.Color
        Else
            groupe(I).address = Union(Range(groupe(I).address), cel).address
        End If
    Next


    'lecture du compte rendu dans un message
    tXt = "il y a " & UBound(groupe) & " groupe(s)" & vbCrLf
    For I = 1 To UBound(groupe)
        tXt = tXt & vbCrLf & "groupe " & I & "  " &...

Nain porte quoi

XLDnaute Junior
vite fait comme ca un dico
VB:
Sub test()
Dim groupe
Set groupe = CreateObject("scripting.dictionary")
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
  groupe(Cells(i, 1).Interior.Color) = groupe(Cells(i, 1).Interior.Color) & Cells(i, 1).Address(0, 0) & IIf(i < Cells(Rows.Count, 1).End(xlUp).Row - 1, ",", "")

Next
For Each elem In groupe
MsgBox "pour la couleur " & elem & " c'est la plage " & groupe(elem)
Next
End Sub
Merci... mais... ça permet de savoir quelle couleur est affectée à quel groupe, mais pas si les couleurs sont différentes.
Dans l'exemple si je met toutes les cellules avec la même couleur ça me donne un seul groupe et si les couleurs ne sont pas contiguës ça ne fonctionne pas non plus.

je sais c'est un truc certainement toukon mais je pédale dessus
 

patricktoulon

XLDnaute Barbatruc
heu ben oui tu pédale dans la choucroute ca c'est sur :D ;)
alors relis ,analyse et reviens quand tu aura compris
surtout quand tu expose ton besoins ne l'expose pas comme ca l'est dans ta tète mais comme ça l'est tout court

visiblement avec le coronamerdetruc tes chaussures marchent a coté de toi :D;)
 

Nain porte quoi

XLDnaute Junior
heu ben oui tu pédale dans la choucroute ca c'est sur :D ;)

Ce qui est rassurant c'est que je ne suis pas seul visiblement ;)

alors relis ,analyse et reviens quand tu aura compris

euh... j'ai relus, j'ai analysé, mais j'ai pas plus compris :confused:

surtout quand tu expose ton besoins ne l'expose pas comme ca l'est dans ta tète mais comme ça l'est tout court

Ben justement, si c'était clair aussi bien sur le papier que dans me tête ça serais certainement plus simple

visiblement avec le coronamerdetruc tes chaussures marchent a coté de toi :D;)

Bon, je vais essayer en marchant sur les mains alors, mais je sais pas si je vais trouver des chaussures adaptées :D :D :D :D :D :D

Si tu as une solution avec mon simple exemple ça m'irait, c'est juste la logique de la prog que je ne capte pas.
 

patricktoulon

XLDnaute Barbatruc
bon
VB:
Private Type gr
    address As String
    couleur As Long
End Type


Sub test()
    Dim groupe() As gr, p As Range, C&, I&, tXt$
    Set plage = Range("A1:A20")
    C = 0
    For Each cel In plage.Cells
        If cel.Interior.Color <> C Then
            I = I + 1: ReDim Preserve groupe(1 To I)
            groupe(I).couleur = cel.Interior.Color
            groupe(I).address = cel.address
            C = cel.Interior.Color
        Else
            groupe(I).address = Union(Range(groupe(I).address), cel).address
        End If
    Next


    'lecture du compte rendu dans un message
    tXt = "il y a " & UBound(groupe) & " groupe(s)" & vbCrLf
    For I = 1 To UBound(groupe)
        tXt = tXt & vbCrLf & "groupe " & I & "  " & groupe(I).address & "  couleur  " & groupe(I).couleur
    Next
    MsgBox tXt
End Sub
tu la vois la logique simple maintenant
démonstration avec une même couleur mais non contiguës
demo4.gif
 

Discussions similaires

Statistiques des forums

Discussions
315 132
Messages
2 116 587
Membres
112 798
dernier inscrit
nicoolio