XL 2016 problème de filtre dans listbox

  • Initiateur de la discussion Initiateur de la discussion saidoush
  • 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 !

saidoush

XLDnaute Junior
Bonjour à tous !!!

J'ai fais un petit formulaire de saisie pour suivre les locations de véhicule perso.
en revanche je ne trouve pas le moyens de rajouter une fonction modifier et filtrer.

j'ai beau rajouter ce code...en vain.

Private Sub FilterListBox()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Synthèse")

Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row

Dim filterValue As String
filterValue = UCase(ComboBox4.Value)

' Supprimer tous les éléments actuels de la ListBox1
Dim i As Long
For i = ListBox1.ListCount - 1 To 0 Step -1
ListBox1.RemoveItem i
Next i

Dim rowCounter As Long
rowCounter = 0

For i = 11 To LastRow
If InStr(1, UCase(ws.Cells(i, "I").Value), filterValue) > 0 Then
ListBox1.AddItem ws.Cells(i, "A").Value
ListBox1.List(rowCounter, 1) = ws.Cells(i, "B").Value
ListBox1.List(rowCounter, 2) = ws.Cells(i, "C").Value
ListBox1.List(rowCounter, 3) = ws.Cells(i, "D").Value
ListBox1.List(rowCounter, 4) = ws.Cells(i, "E").Value
ListBox1.List(rowCounter, 5) = ws.Cells(i, "F").Value
ListBox1.List(rowCounter, 6) = ws.Cells(i, "G").Value
ListBox1.List(rowCounter, 7) = ws.Cells(i, "H").Value
ListBox1.List(rowCounter, 8) = ws.Cells(i, "I").Value
ListBox1.List(rowCounter, 9) = ws.Cells(i, "J").Value
ListBox1.List(rowCounter, 10) = ws.Cells(i, "K").Value
ListBox1.List(rowCounter, 11) = ws.Cells(i, "L").Value
rowCounter = rowCounter + 1
End If
Next i
End Sub
 

Pièces jointes

Encore une chose et ce sera ma dernière intervention.

Avec la méthode .List les formats des colonnes monétaires ne sont pas conservés.

Pour les conserver on peut revenir à la méthode .RowSource.

Mais pour cela il faut utiliser la feuille auxiliaire Filtre, voyez le fichier joint et cette macro :
VB:
Sub filter_data_in_listbox()
Dim x$, n&
Sheets("Filtre").Cells.Delete
With [Tableau1] 'tableau structuré
    x = ComboBox4.Value
    n = Application.CountIf(.Columns(9), x)
    If n = 0 Then ListBox1.RowSource = "": Exit Sub
    .ListObject.Range.AutoFilter 9, x 'filtre automatique
    .ListObject.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("Filtre").[A1]
    .ListObject.Range.AutoFilter 'ôte le filtre
    ListBox1.RowSource = "Filtre!A2:L" & n + 1
End With
End Sub
Pas mal...

N'hésites pas... t'es interventions sont plus que pertinentes.

Merci
 
Et pour la suppression en cliquant direct sur la listbox1 tu as une idée ?
Parce que sinon je passe par la BDD...
Vous connaissez la solution puisqu'au post #1 vous utilisiez RemoveItem :
VB:
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox1.ListIndex = -1 Then Exit Sub
    ListBox1.RemoveItem ListBox1.ListIndex
End Sub
Fonctionne si la ListBox est chargée par la méthode .List et pas par la méthode .RowSource.
 
Dernière édition:
Bonsoir saidoush, le forum,

Suite de mon post #37, il faut bien sûr mettre à jour la base de données.

En l'absence de mémorisation des lignes dans la ListBox il faut se résoudre à faire une boucle en s'appuyant par exemple sur les colonnes A (Nom) B (Prénom) et E (Date de prise en compte) :
VB:
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i&, x$, tablo, j&
    With ListBox1
        i = .ListIndex
        If i = -1 Then Exit Sub
        If MsgBox(.List(i, 0) & " " & .List(i, 1) & " du " & .List(i, 4) & " sera supprimé de la base ?", 4) = 7 Then Exit Sub
        x = .List(i, 0) & .List(i, 1) & .List(i, 4)
        tablo = [Tableau1].Resize(, 5)
        For j = 1 To UBound(tablo)
            If tablo(j, 1) & tablo(j, 2) & tablo(j, 5) = x Then [Tableau1].Rows(j).Delete xlUp: Exit For
        Next
        .RemoveItem i
    End With
End Sub
A+
 

Pièces jointes

ChTi160, job75, Merci!!! à vous 2...

Pour le premier, une présentation impeccable et sophistiquée, pour le second une appli aboutie et opérationnelle. Bien qu'il manque cet aspect ludique je vais conserver le fichier de job175 qui est déjà fonctionnelle en attendant qu'il fusionne…

Merci pour votre aide et implication, c'est au delà de mes attentes!!
Espérant recevoir prochainement votre aide😉.
 
Notre forum d’entraide est 100 % gratuit et le restera.
Aucune formation payante, aucun fichier à acheter, rien à vendre. Mais comme tout site, nous devons couvrir nos frais pour continuer à vous accompagner.
Soutenez-nous en souscrivant à un compte membre : c’est rapide, vous choisissez simplement votre niveau de soutien et le tour est joué.

Je soutiens la communauté et j’accède à mon compte membre

Discussions similaires

Réponses
0
Affichages
364
Réponses
1
Affichages
447
Réponses
2
Affichages
687
Réponses
10
Affichages
713
Retour