Alimenter Listbox depuis plusieurs feuilles
LeDbutantVBAFou
-
danielc0 Messages postés 2179 Date d'inscription Statut Membre Dernière intervention -
danielc0 Messages postés 2179 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Mon nouveau problème!
J'ai le même tableau en feuille 2,3,4,5 et 6. (6 n'est pas la dernière feuille).
Ces feuilles correspond et porte le nom des années, 2019, 2020, 2021, 2022, 2023.
J'ai créer un Userform pour faire un "moteur de recherche" assez basic sur ces tableaux.
J'ai trouvé un code que j'ai adapté mais uniquement sur une feuille.
J'ai besoin que toutes les feuilles ci-dessus alimentes la listbox.
Le code que j'ai trouvé pour le moment:
D'avance merci pour votre aide.
Mon nouveau problème!
J'ai le même tableau en feuille 2,3,4,5 et 6. (6 n'est pas la dernière feuille).
Ces feuilles correspond et porte le nom des années, 2019, 2020, 2021, 2022, 2023.
J'ai créer un Userform pour faire un "moteur de recherche" assez basic sur ces tableaux.
J'ai trouvé un code que j'ai adapté mais uniquement sur une feuille.
J'ai besoin que toutes les feuilles ci-dessus alimentes la listbox.
Le code que j'ai trouvé pour le moment:
Dim f, choix(), Rng, Ncol
Private Sub UserForm_Initialize()
Set f = Sheets("2019")
Set Rng = f.Range("A11:G" & f.[a65000].End(xlUp).Row)
Ncol = Rng.Columns.Count
'---- entêtes ListBox
Me.ListBox1.ColumnCount = Ncol
Me.ListBox1.ColumnWidths = 35 & ";" & 80 & ";" & 110 & ";" & 60 & ";" & 60 & ";" & 150 & ";" & 60
'--
TblTmp = Rng.Value
For I = LBound(TblTmp) To UBound(TblTmp)
ReDim Preserve choix(1 To I)
For k = LBound(TblTmp) To UBound(TblTmp, 2)
choix(I) = choix(I) & TblTmp(I, k) & " * "
Next k
Next I
Me.ListBox1.List = Rng.Value
End Sub
Private Sub TextBox1_Change()
If Me.TextBox1 <> "" Then
mots = Split(Trim(Me.TextBox1), " ")
Tbl = choix
For I = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(I), True, vbTextCompare)
Next I
If UBound(Tbl) > -1 Then
Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
For I = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(I), "*")
For k = 1 To Ncol: b(I + 1, k) = a(k - 1): Next k
Next I
Me.ListBox1.List = b
' Me.Label1.Caption = UBound(Tbl) + 1
End If
Else
UserForm_Initialize
End If
End Sub
D'avance merci pour votre aide.
1 réponse
-
Bonjour,
Essaie :
Dim f, choix(), Rng, Ncol Private Sub UserForm_Initialize() Dim Ctr As Long, X As Integer, Y As Integer 'car = Application.Transpose(Tbl) For i = 2 To 6 Set f = Sheets(i) Set Rng = f.Range("A11:G" & f.[a65000].End(xlUp).Row) For X = 1 To Rng.Rows.Count Me.ListBox1.AddItem f.Cells(Rng.Row - 1 + X, 1) For Y = 2 To 7 With Me.ListBox1 .List(.ListCount - 1, Y - 1) = f.Cells(Rng.Row - 1 + X, Y) End With Next Y Next X Next i Ncol = Rng.Columns.Count '---- entêtes ListBox Me.ListBox1.ColumnCount = Ncol Me.ListBox1.ColumnWidths = 35 & ";" & 80 & ";" & 110 & ";" & 60 & ";" & 60 & ";" & 150 & ";" & 60 '-- TblTmp = Rng.Value For i = LBound(TblTmp) To UBound(TblTmp) ReDim Preserve choix(1 To i) For k = LBound(TblTmp) To UBound(TblTmp, 2) choix(i) = choix(i) & TblTmp(i, k) & " * " Next k Next i End Sub Private Sub TextBox1_Change() If Me.TextBox1 <> "" Then mots = Split(Trim(Me.TextBox1), " ") Tbl = choix For i = LBound(mots) To UBound(mots) Tbl = Filter(Tbl, mots(i), True, vbTextCompare) Next i If UBound(Tbl) > -1 Then Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol) For i = LBound(Tbl) To UBound(Tbl) a = Split(Tbl(i), "*") For k = 1 To Ncol: b(i + 1, k) = a(k - 1): Next k Next i Me.ListBox1.List = b ' Me.Label1.Caption = UBound(Tbl) + 1 End If Else UserForm_Initialize End If End Sub
Cordialement.
Daniel
