alimenter listbox multicolonne en fonction couleur cellules feuille

  • Initiateur de la discussion Initiateur de la discussion jtitin
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jtitin

XLDnaute Occasionnel
bonjour à tous
je ne trouve pas dans le forum de solution.
alimenter une listbox multicolonne (+de 10 colonnes) en fonction des couleurs dans les cellules de certaines colonne d'une feuille
j'ai un 1er filtre par la listbox1, lorsque je sélectionne un item dans cette listbox, la listbox2 multicolonne s'alimente en fonction si les cellules des colonnes H ou L sont rouge ou et jaune. je joint un exemple avec feuille 13 colonnes mais mon fichier est beaucoup plus grans + de 50 colonnes et recherche couleur rouge ou jaune sur + de 2 colonnes. je l'adapterai en fonction de vos propositions.
Merci pour votre aide
 

Pièces jointes

Re : alimenter listbox multicolonne en fonction couleur cellules feuille

bonjour jtitin
une possibilité à tester
Code:
Private Sub ListBox1_Click()'bebere
    Dim tbl() As String

    'ReDim tbl(0 To 7, 0 To i)

    If Me.ListBox1 <> "" Then
        Me.ListBox2.Clear
        i = 0

        With Worksheets("Feuil1")
            Set c = .Range("E6:E" & .Range("E65536").End(xlUp).Row).Find(ListBox1, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    If c.Offset(, 3).Interior.ColorIndex = 3 Or c.Offset(, 3).Interior.ColorIndex = 6 Then    'date1
                        ReDim Preserve tbl(0 To 9, 0 To i)
                        tbl(0, i) = c
                        tbl(1, i) = c.Offset(, 1)
                        tbl(2, i) = c.Offset(, 2)
                        tbl(3, i) = c.Offset(, 3)
                        tbl(4, i) = c.Offset(, 4)
                        tbl(5, i) = c.Offset(, 5)
                        tbl(6, i) = c.Offset(, 6)
                        tbl(7, i) = c.Offset(, 7)
                        tbl(8, i) = c.Offset(, 8)
                        tbl(9, i) = "date1"
                        i = i + 1
                    End If
                    Set c = .Range("E6:E" & .Range("E65536").End(xlUp).Row).FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If

            Set c = .Range("E6:E" & .Range("E65536").End(xlUp).Row).Find(ListBox1, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    If c.Offset(, 7).Interior.ColorIndex = 3 Or c.Offset(, 7).Interior.ColorIndex = 6 Then    'date2
                        ReDim Preserve tbl(0 To 9, 0 To i)
                        tbl(0, i) = c
                        tbl(1, i) = c.Offset(, 1)
                        tbl(2, i) = c.Offset(, 2)
                        tbl(3, i) = c.Offset(, 3)
                        tbl(4, i) = c.Offset(, 4)
                        tbl(5, i) = c.Offset(, 5)
                        tbl(6, i) = c.Offset(, 6)
                        tbl(7, i) = c.Offset(, 7)
                        tbl(8, i) = c.Offset(, 8)
                        tbl(9, i) = "date2"
                        i = i + 1
                    End If

                    Set c = .Range("E6:E" & .Range("E65536").End(xlUp).Row).FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If

        End With

        If UBound(tbl, 2) > 0 Then
            Me.ListBox2.List = Application.Transpose(tbl)
        Else
            Me.ListBox2.AddItem
            Me.ListBox2.Column() = tbl
        End If
    End If

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
489
Retour