alimenter listbox multicolonne en fonction couleur cellules feuille

[jtitin]

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

 

[Bebere]

Re : alimenter listbox multicolonne en fonction couleur cellules feuille

bonjour jtitin
une possibilité à tester

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

 

[jtitin]

Re : alimenter listbox multicolonne en fonction couleur cellules feuille

Merci Bebere
C'est tout à fait ce que je cherchai
merci