XL 2010 searchable listbox

Créer une discussion
Répondre

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 !

S'inscrire
H

Hafi.alaoui

XLDnaute Junior
Bonjour
j'ai essayé d'effectué une listbox pour rechercher dans un tableau un nom pour qu'il me trouve toute ligne concernant le nom,je ne sais pas comment le traiter moi même,
je ne suis pas un professionnelle dur le développement,et si possible qu'il me donne le total,
merci à vous
 

Pièces jointes

Trier par date Trier par votes
Bonjour,

VB: 
Dim TblBD(), NbCol
Option Compare Text
Private Sub UserForm_Initialize()
  Dim f, Rng
  Set f = Sheets("suivis_facture")
  Set Rng = f.Range("A4:K" & f.[A650000].End(xlUp).Row)
  TblBD = Rng.Value
  NbCol = UBound(TblBD, 2)
  Me.ListBox1.List = TblBD
  Me.ListBox1.ColumnCount = NbCol
  Me.ListBox1.ColumnWidths = "30;60;80;60;50;60;60;60;50;50;50"
End Sub

Private Sub TextBox1_Change()
  Dim colRecherche, clé, i, n, k
  colRecherche = 3
  clé = "*" & Me.TextBox1 & "*"
  Dim Tbl()
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.List = TblBD
End Sub


Boisgontier
 

Pièces jointes

Vote positif 0 Vote négatif
BOISGONTIER à dit:
Bonjour,

VB: 
Dim TblBD(), NbCol
Option Compare Text
Private Sub UserForm_Initialize()
  Dim f, Rng
  Set f = Sheets("suivis_facture")
  Set Rng = f.Range("A4:K" & f.[A650000].End(xlUp).Row)
  TblBD = Rng.Value
  NbCol = UBound(TblBD, 2)
  Me.ListBox1.List = TblBD
  Me.ListBox1.ColumnCount = NbCol
  Me.ListBox1.ColumnWidths = "30;60;80;60;50;60;60;60;50;50;50"
End Sub

Private Sub TextBox1_Change()
  Dim colRecherche, clé, i, n, k
  colRecherche = 3
  clé = "*" & Me.TextBox1 & "*"
  Dim Tbl()
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.List = TblBD
End Sub


Boisgontier
Cliquez pour agrandir...
wi c'est bien ça marche
 
Vote positif 0 Vote négatif
Bonjour,

Exemple avec entête

VB: 
Dim Rng, TblBD(), NbCol
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set Rng = f.Range("A2:K" & f.[A650000].End(xlUp).Row)
  TblBD = Rng.Value
  For i = 1 To UBound(TblBD):
    TotalFact = TotalFact + TblBD(i, 4)
    TotalCrédit = TotalCrédit + TblBD(i, 10)
    TblBD(i, 4) = Format(TblBD(i, 4), "0000.00")
  Next i
  NbCol = UBound(TblBD, 2)
  Me.ListBox1.List = TblBD
  Me.TextBox2 = Format(TotalFact, "0000.00")
  Me.TextBox3 = Format(TotalCrédit, "0000.00")
  Me.ListBox1.ColumnCount = NbCol
  'Me.ListBox1.ColumnWidths = "30;60;90;60"
  EnteteListBox
End Sub

Private Sub TextBox1_Change()
  colRecherche = 3
  clé = "*" & Me.TextBox1 & "*"
  Dim Tbl()
  TotalFact = 0
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Then
        n = n + 1
        ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
        TotalFact = TotalFact + TblBD(i, 4)
        TotalCrédit = TotalCrédit + TblBD(i, 10)
     End If
  Next i
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     Me.TextBox2 = Format(TotalFact, "0000.00")
     Me.TextBox3 = Format(TotalCrédit, "0000.00")
   Else
     Me.ListBox1.List = TblBD
     Me.TextBox2 = Format(Application.Sum(Application.Index(TblBD, , 4)), "0000.00")
     Me.TextBox3 = Format(Application.Sum(Application.Index(TblBD, , 10)), "0000.00")
   End If
End Sub

Sub EnteteListBox()
  x = Me.ListBox1.Left + 8
  Y = Me.ListBox1.Top - 12
  For i = 1 To NbCol
    Set lab = Me.Controls.Add("Forms.Label.1")
    lab.Caption = Rng.Offset(-1).Cells(1, i)
    lab.Top = Y
    lab.Left = x
    x = x + Rng.Columns(i).Width * 1.1
    temp = temp & Rng.Columns(i).Width * 1.1 & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnWidths = temp
End Sub

Boisgontier
 

Pièces jointes

Vote positif 0 Vote négatif
BOISGONTIER à dit:
Bonjour,

Exemple avec entête

VB: 
Dim Rng, TblBD(), NbCol
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set Rng = f.Range("A2:K" & f.[A650000].End(xlUp).Row)
  TblBD = Rng.Value
  For i = 1 To UBound(TblBD):
    TotalFact = TotalFact + TblBD(i, 4)
    TotalCrédit = TotalCrédit + TblBD(i, 10)
    TblBD(i, 4) = Format(TblBD(i, 4), "0000.00")
  Next i
  NbCol = UBound(TblBD, 2)
  Me.ListBox1.List = TblBD
  Me.TextBox2 = Format(TotalFact, "0000.00")
  Me.TextBox3 = Format(TotalCrédit, "0000.00")
  Me.ListBox1.ColumnCount = NbCol
  'Me.ListBox1.ColumnWidths = "30;60;90;60"
  EnteteListBox
End Sub

Private Sub TextBox1_Change()
  colRecherche = 3
  clé = "*" & Me.TextBox1 & "*"
  Dim Tbl()
  TotalFact = 0
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Then
        n = n + 1
        ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
        TotalFact = TotalFact + TblBD(i, 4)
        TotalCrédit = TotalCrédit + TblBD(i, 10)
     End If
  Next i
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     Me.TextBox2 = Format(TotalFact, "0000.00")
     Me.TextBox3 = Format(TotalCrédit, "0000.00")
   Else
     Me.ListBox1.List = TblBD
     Me.TextBox2 = Format(Application.Sum(Application.Index(TblBD, , 4)), "0000.00")
     Me.TextBox3 = Format(Application.Sum(Application.Index(TblBD, , 10)), "0000.00")
   End If
End Sub

Sub EnteteListBox()
  x = Me.ListBox1.Left + 8
  Y = Me.ListBox1.Top - 12
  For i = 1 To NbCol
    Set lab = Me.Controls.Add("Forms.Label.1")
    lab.Caption = Rng.Offset(-1).Cells(1, i)
    lab.Top = Y
    lab.Left = x
    x = x + Rng.Columns(i).Width * 1.1
    temp = temp & Rng.Columns(i).Width * 1.1 & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnWidths = temp
End Sub

Boisgontier
Cliquez pour agrandir...
merci infiniment cela a bien fonctionné
 
Vote positif 0 Vote négatif
Bonjour,

Une autre solution:

-Choix du client dans un ComboBox
-Nécessite une feuille intermédiaire
-Entete simple mais qui oblige à calculer les largeurs de colonnes

VB: 
Option Compare Text
Dim f, RngBD, ColRecherche
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set d = CreateObject("Scripting.Dictionary")
  Set RngBD = f.[A1].CurrentRegion.Offset(1)
  ColRecherche = 3
  d("*") = ""
  For i = 1 To RngBD.Rows.Count
     clé = RngBD.Cells(i, ColRecherche): d(clé) = ""
  Next i
  Me.ComboBox1.List = d.keys                        ' liste des professions sans doublons
  Me.ListBox1.ColumnCount = RngBD.Columns.Count
  Me.ListBox1.ColumnWidths = "20;50;90;60;50;50;50;50;50;50;50"    ' à adapter
  Me.ListBox1.ColumnHeads = True
  ComboBox1_click
End Sub

Private Sub ComboBox1_click()
  Set f2 = Sheets("filtre")
  f2.Cells.Clear
  f2.[Z1] = RngBD.Offset(-1).Cells(1, ColRecherche): f2.[Z2] = Me.ComboBox1
  f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f2.[Z1:Z2], _
      CopyToRange:=f2.[A1], Unique:=False
  Set RngFiltre = f2.[A1].CurrentRegion.Offset(1).Resize(f2.[A1].CurrentRegion.Rows.Count - 1)
  Me.ListBox1.RowSource = RngFiltre.Address(External:=True)
  Me.TextBox2 = Format(Application.Sum(Application.Index(RngFiltre, , 4)), "0000.00")
  Me.TextBox3 = Format(Application.Sum(Application.Index(RngFiltre, , 10)), "0000.00")
End Sub

Autre exemple: http://boisgontierjacques.free.fr/fichiers/Formulaire/FormRechercheTextBox3.xls

Boisgontier
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

K
  • Résolu(e)
XL 2016 Filtre et affichage listbox
Réponses
9
Affichages
360
KRUG WOO
K
C
  • Question Question
XL 2010 Définir le rowsource dans un formulaire
Réponses
8
Affichages
403
CC76
C
C
  • Résolu(e)
Microsoft 365 Recherche de doublons à plusieurs critères sur plusieurs colonnes
Réponses
4
Affichages
119
job75
job75
jcf6464
  • Résolu(e)
Microsoft 365 Userform Filtres ne fonctionne pas
2 3 4
Réponses
46
Affichages
1 K
jcf6464
jcf6464
Z
  • Question Question
Autres Analyser les Ij avancées des IJ remboursées
2
Réponses
25
Affichages
532
cathodique
cathodique
A
  • Question Question
XL 2021 listbox
2
Réponses
18
Affichages
503
Dranreb
Dranreb
G
  • Question Question
Microsoft 365 Labels qui se dimensionnent tous seuls.
Réponses
3
Affichages
259
GClaire
G
A
  • Question Question
Microsoft 365 Affichage , recherche et extraire des données .
Réponses
1
Affichages
152
vgendron
vgendron
jeff1494
  • Question Question
XL 2021 Ajout de zones dans un USF par VBA
2
Réponses
16
Affichages
450
jeff1494
jeff1494
S
  • Résolu(e)
XL 2016 Récupération valeurs cellules lignes autre onglet
Réponses
11
Affichages
128
safranien
S
C
  • Résolu(e)
Autres Validation de données avant verrouillage de la ligne
2
Réponses
17
Affichages
308
com689
C
M
  • Question Question
XL 2021 Certitude d'information fonction somme
Réponses
5
Affichages
115
sylvanu
sylvanu
L
  • Question Question
Microsoft 365 Recherche dans fichier excel dans un répertoire
2 3 4
Réponses
50
Affichages
2 K
Loulou27
L
H
  • Question Question
XL 2010 [RESOLU] recuperer ancien enregistrement excel
2
Réponses
19
Affichages
872
TooFatBoy
TooFatBoy
B
  • Question Question
Microsoft 365 Faire la somme de plusieurs tableaux
2
Réponses
17
Affichages
1 K
AtTheOne
AtTheOne
treza88
  • Question Question
Microsoft 365 VBA : Problème de reconnaissance de variable avec fonction FIND
Réponses
2
Affichages
244
Dranreb
Dranreb
jeff1494
  • Résolu(e)
XL 2021 PB Alimentation Tableau structuré depuis un ListBox
2
Réponses
27
Affichages
768
jeff1494
jeff1494
A
  • Question Question
XL 2021 Comment préserver la première valeur d'une cellule uniquement si
2 3
Réponses
34
Affichages
1 K
Alamyr
A
K
  • Résolu(e)
Microsoft 365 Récupération équation courbe de tendance
Réponses
6
Affichages
130
Karkasse
K
K
  • Question Question
Microsoft 365 Exercice compte en banque
Réponses
10
Affichages
389
klemasson
K
Retour