Supprimer Les Lignes Via ListBox Multiselect

[t70527t@yahoo.fr]

Bonjour à Tous

je débute en VBA sur Excel et je bloque sur le problème suivant

A partir d'une feuille Excel je rempli une ListBox multiselect => Ca c'est OK
Je voudrai quand un utilisateur sélectionne une ou plusieurs valeurs dans la Listbox que toutes les lignes qui contiennent ces valeurs soient supprimer sur la feuille Excel lorsque l'utilisateur appuie sur le bouton supprimer.

Suis-je clair?
Ci-joint un exemple:

Merci à tous pour votre aide
thierry

 

[Guest]

Re : Supprimer Les Lignes Via ListBox Multiselect

Bonjour Thierry, et bienvenue sur XLD

Le fichier, est resté coincé?

A+

 

[t70527t@yahoo.fr]

Re : Supprimer Les Lignes Via ListBox Multiselect

Sorry Fichier trop gros

Merci

 

[Guest]

Re : Supprimer Les Lignes Via ListBox Multiselect

Re,

Une question avant de commencer:

Est-ce que les valeurs affichée dans listbox peuvent corresprondre à plusieurs lignes dans la feuille?

A+

 

[t70527t@yahoo.fr]

Re : Supprimer Les Lignes Via ListBox Multiselect

Bonjour HASCO

Merci pour ton Aide.

Oui la valeur dans la ListBox correspond à plusieurs lignes dans la feuille ( normalement une par mois )

Cordialement
Thierry

 

[Guest]

Re : Supprimer Les Lignes Via ListBox Multiselect

Re,

Voici ton fichier modifié

A+

 

[ChTi160]

Re : Supprimer Les Lignes Via ListBox Multiselect

Salut Thierry
Bonjour Le Fil
Bonjour leForum

voila ce que j'ai modifié a excellant travail D'Hasco

Private Sub CommandButton3_Click()
    Dim i As Integer
    Dim Plage As Range, Lignes As Range, c As Range
    Dim adr1 As String
     Dim txt As String
    With Worksheets("Autres POWERS")
    Set Plage = .Range("c2:c" & .Range("c" & .Rows.Count).End(xlUp).Row)
    End With

    With UserForm1.ListBox3
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Set c = Plage.Find(.List(i), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
                If Not c Is Nothing Then
                    adr1 = c.Address
                    Do
                        If Lignes Is Nothing Then Set Lignes = c Else Set Lignes = Union(Lignes, c)
                        Set c = Plage.FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> adr1
                End If
            End If
            
        Next i
    End With
    [COLOR=Red]If[COLOR=Black] Not Lignes Is Nothing Then
       Lignes.EntireRow.Delete[/COLOR]
       UserForm_Activate [COLOR=DarkGreen]'on réinitialise le Userform[/COLOR]
    End If[/COLOR]
End Sub

Private Sub UserForm_Activate()
    Me.MultiPage1.Value = 0                     '-- UserForm toujours ouvert sur la page 1 du MultiPage1--
    Dim Tablo As Variant, Tempo As Variant, i As Long, j As Long
    With Worksheets("Autres POWERS")       '--Activation Sheet25("Autres POWERS")--
    Tablo = .Range("c2:c" & .Range("c" & .Rows.Count).End(xlUp).Row).Value
    For i = 1 To UBound(Tablo)                  '-- Début du tri par ordre alphabétique --
        For j = 1 To UBound(Tablo)
            If Tablo(i, 1) < Tablo(j, 1) Then
                Tempo = Tablo(i, 1)
                Tablo(i, 1) = Tablo(j, 1)
                Tablo(j, 1) = Tempo
            End If
        Next j
    Next i '- Fin du tri par ordre alphabétique --
    End With
    [COLOR=Red]With[/COLOR] UserForm1.ListBox3
         [COLOR=Red].Clear[/COLOR]   [COLOR=DarkGreen]'on efface la listbox[/COLOR]
         .AddItem Tablo(1, 1)            '--Debut remplissage ListBox3 sans doublons--
        For i = 2 To UBound(Tablo)
            If Tablo(i, 1) <> Tablo(i - 1, 1) Then .AddItem Tablo(i, 1)
        Next                                        '--Fin remplissage ListBox3 sans doublons--
   [COLOR=Red]End With[/COLOR]
End Sub

Bonne journée

 

[Guest]

Re : Supprimer Les Lignes Via ListBox Multiselect

Re,

Hello Cht'i content de te croiser. Je ne voulais pas devancer les demandes de notre ami mais je sentais, que ce serait la prochaine question.

A+++

 

[t70527t@yahoo.fr]

Re : Supprimer Les Lignes Via ListBox Multiselect

Mr HASCO
Merci beaucoup ...Ca marche .... C'est Super ...Merci Merci

Effectivement HASCO c'était ma prochaine question merci à CHTi160
pour la réponse.

Merci et Cordialement
Thierry