XL 2010 searchable listbox

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

  • tableaufacture.1.xlsm
    781.2 KB · Affichages: 13
Trier par date Trier par votes
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
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

  • Copie de tableaufacture.1.xlsm
    817.8 KB · Affichages: 9
Vote positif 0 Vote négatif
H

Hafi.alaoui

XLDnaute Junior
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
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
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

  • Copie de FiltreTextBoxMultiCol-1.xlsm
    38.7 KB · Affichages: 7
Vote positif 0 Vote négatif
H

Hafi.alaoui

XLDnaute Junior
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
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
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

  • FiltreComboBoxMultiCol.xlsm
    38.6 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
XL 2016 listbox vers uderform
2
Réponses
18
Affichages
633
LJII
L
M
  • Résolu(e)
Microsoft 365 Code de tri
2
Réponses
22
Affichages
305
Dudu2
Dudu2
T
  • Question
Listbox 14 colonnes
Réponses
6
Affichages
463
TAL
T
M
  • Question
Microsoft 365 Pilotage Listbox avec des combobox
Réponses
8
Affichages
225
meca13
M
E
  • Résolu(e)
Microsoft 365 Listbox et Tableau filtré
Réponses
10
Affichages
251
eric72
E
N
  • Question
XL 2019 Mettre en gras éléments du graphique avec macro
Réponses
4
Affichages
352
Nasseuz
N
N
  • Question
Microsoft 365 Planning Hopital de jour
Réponses
1
Affichages
194
sylvanu
sylvanu
A
  • Question
XL 2019 rechercher un nom dans plusieurs fichiers
Réponses
4
Affichages
254
sylvanu
sylvanu
P
  • Question
Microsoft 365 VBA - Enregistrer un fichier en pdf dans un dossier dont on ne connait que les 4 premiers caractères
Réponses
2
Affichages
230
phil75016
P
J
  • Question
XL 2016 Affichage onglets d'un classeur dans la listbox d'un userform
Réponses
2
Affichages
302
jeff2318
J

Membres actuellement en ligne

7 membres et 92 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 215
Messages
2 086 326
Membres
103 180
dernier inscrit
Vcr