Extraction listbox

Bonjour bonjour,

Un jours, un problème:

Je dois comparer les élément d'une liste box à une base de donné sur excel pour afficher seulement les élément présent dans la liste box

Je m'explique,

en gros j'ai ceci:

colone A Colone B

critère 1

sous critère 1.1

sous critère 1.2

critère 2

sous critère 2.1

sous critère 2.2

Critère3

sous critère 3.1

sous critère 3.2

sous critère 3.3

et si par exemple dans ma liste box j'ai les sous critère 2.1 , 2.2, 3.1, et 3.3

j'aimerai afficher un nouveaux tableau avec:

colone A Colone B

Critère 2

sous critère 2.1

sous critère 2.2

Critère3

sous critère 3.1

sous critère 3.3

pour l'instant je copie ma base initial dans une nouvelle feuille et je supprime les cellule si elle ne correspondent pas à la liste box par la manière suivante:

Dim cell As Range
Dim i, As Integer
Dim ok As Boolean

For Each cell In ActiveSheet.Range("B1:B40")
ok = False
    If IsEmpty(cell) = False Then
        For i = 0 To (ListBox1.ListCount) - 1
            If ListBox1.List(i) = cell.Text Then
                ok = True
            End If
        Next i

        If ok = False Then

            Rows(cell.Row).clearcontents

        End If
    End If
Next cell

cependant j'aimerai supprimer les lignes vides et les titres "critère" si il n'y a pas de sous critère correspondant!

Il est déjà vendredi et j'ai plus trop d'imagination la... si quelqu'un peu m'aider!! ce serai avec plaisir car j'ai un peu l’impression de partir en vrille.

Merci!

bonne fin de journée

j'en suis là:

Dim cell As Range
Dim i As Integer
Dim ok As Boolean

step:
For Each cell In ActiveSheet.Range("C1:C40")

ok = False
    If IsEmpty(cell) = False Then
        For i = 0 To (ListBox1.ListCount) - 1
            If ListBox1.List(i) = cell.Text Then
                ok = True

            End If
        Next i

        If ok = False Then

            cell.EntireRow.Delete
           GoTo step

        End If
    End If
Next cell

ceci me permet de supprimer les sous critères qui ne sont pas dans la liste box mais comment supprimer les critères parents si aucun sous critère n'a été sélectionné?? :s

finalement j'ai trouvé un truc tout pourris mais ça a le mérite de marcher

(sur trois colonne avec marquage rouge en fin de critères et sous critères):

Private Sub CommandButton1_Click()
Sheets("result").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Feuil1").Select
ActiveSheet.Copy before:=Worksheets(ActiveSheet.Name)
ActiveSheet.Name = "result"

Dim cell, cellu As Range
Dim i, nl, nc As Integer
Dim ok As Boolean

step:
For Each cell In ActiveSheet.Range("C1:C40")

ok = False
    If IsEmpty(cell) = False Then
        For i = 0 To (ListBox1.ListCount) - 1
            If ListBox1.List(i) = cell.Text Then
                ok = True

            End If
        Next i

        If ok = False Then
            cell.EntireRow.Delete
           GoTo step
        End If
    End If
Next cell

step1:
For Each cell In ActiveSheet.Range("B1:B40")
    If IsEmpty(cell) = False Then
        If cell.Offset(1, 1).Interior.Color = vbRed Then
            cell.EntireRow.Delete
            GoTo step1
        End If
    End If
Next cell

step2:
For Each cell In ActiveSheet.Range("A1:A40")
    If IsEmpty(cell) = False Then
        If IsEmpty(cell.Offset(1, 1)) = True And cell.Offset(1, 2).Interior.Color = vbRed Then
            cell.EntireRow.Delete
            GoTo step2
        End If
   End If
Next cell

End Sub

Bonjour

Considères tu ton sujet comme résolu ?

Dans la négative, un fichier en notant ce que tu as et ce que tu veux serait le bienvenu