FiltreAutoSup1000

Le
Jean-Paul V
Bonjour à tous

J'ai trouvé dans Excelabo un fichier de JB permettant grace à une Combobox
de filtrer une Base de Donnée de plus 1000 éléments.
J'ai repris cette macro et je lui ai ajouté une deuxième Combobox, j'ai
besoin de filtrer un fichier articles classé par code , soit par code , soit
par désignation.
La macro modifiée donne :
Sub Auto_Open()
Set maliste = CreateObject("Scripting.Dictionary")
Set meslibel = CreateObject("Scripting.Dictionary")
For Each c In Range([A7], [A65000].End(xlUp))
If Not maliste.Exists(c.Value) Then maliste.Add c.Value, c.Value
Next c
For Each c In Range([B7], [B65000].End(xlUp))
If Not meslibel.Exists(c.Value) Then meslibel.Add c.Value, c.Value
Next c
Sheets(1).ComboBox1.List = maliste.items
Sheets(1).ComboBox2.List = meslibel.items
End Sub
Serait-il possible en ajoutant des instructions d'avoir les 2 objets maliste
et meslibel classés ?

@+ J'espère
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Hervé
Le #4672911
Bonsoitr Jean-Paul,
Regarde ce qui suit et adapte :
Sub Auto_Open()
Dim Fe As Object
Dim Col As New Collection
Dim Plage As Range
Dim I As Long

Set Fe = Feuil1 'nom dans VBE
'1ère plage
With Fe
Set Plage = .Range(.[A7], .[A65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next
'vide le ComboBox1 et le rempli
Fe.ComboBox1.Clear
For I = 1 To Col.Count
Fe.ComboBox1.AddItem Col(I)
Next I
'réinitialise la collection
Set Col = Nothing
'2ème plage
With Fe
Set Plage = .Range(.[B7], .[B65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next

'vide le ComboBox2 et le rempli
Fe.ComboBox2.Clear
For I = 1 To Col.Count
Fe.ComboBox2.AddItem Col(I)
Next I

Set Plage = Nothing
Set Col = Nothing

End Sub

Hervé.
"Jean-Paul V" de news:
Bonjour à tous

J'ai trouvé dans Excelabo un fichier de JB permettant grace à une Combobox
de filtrer une Base de Donnée de plus 1000 éléments.
J'ai repris cette macro et je lui ai ajouté une deuxième Combobox, j'ai
besoin de filtrer un fichier articles classé par code , soit par code ,
soit

par désignation.
La macro modifiée donne :
Sub Auto_Open()
Set maliste = CreateObject("Scripting.Dictionary")
Set meslibel = CreateObject("Scripting.Dictionary")
For Each c In Range([A7], [A65000].End(xlUp))
If Not maliste.Exists(c.Value) Then maliste.Add c.Value, c.Value
Next c
For Each c In Range([B7], [B65000].End(xlUp))
If Not meslibel.Exists(c.Value) Then meslibel.Add c.Value, c.Value
Next c
Sheets(1).ComboBox1.List = maliste.items
Sheets(1).ComboBox2.List = meslibel.items
End Sub
Serait-il possible en ajoutant des instructions d'avoir les 2 objets
maliste

et meslibel classés ?

@+ J'espère




JB
Le #4672871
Bonsoir,

http://boisgontierjacques.free.fr/fichiers/Filtre/FiltreAutoSup1000_2.xls

Sub Auto_Open()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range([A4], [A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Sheets(1).ComboBox1.List = MonDico.items
'---- par ville
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range([B4], [B65000].End(xlUp))
If Not MonDico2.Exists(c.Value) Then MonDico2.Add c.Value, c.Value
Next c
temp = MonDico2.items
Call tri(temp, LBound(temp), UBound(temp))
Sheets(1).ComboBox2.List = temp 'mondico2.items
End Sub

Sub tout()
On Error Resume Next
ActiveSheet.ShowAllData
End Sub

Sub tri(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

JB
http://boisgontierjacques.free.fr/

On 23 août, 20:57, "Hervé"
Bonsoitr Jean-Paul,
Regarde ce qui suit et adapte :
Sub Auto_Open()
Dim Fe As Object
Dim Col As New Collection
Dim Plage As Range
Dim I As Long

Set Fe = Feuil1 'nom dans VBE
'1ère plage
With Fe
Set Plage = .Range(.[A7], .[A65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next
'vide le ComboBox1 et le rempli
Fe.ComboBox1.Clear
For I = 1 To Col.Count
Fe.ComboBox1.AddItem Col(I)
Next I
'réinitialise la collection
Set Col = Nothing
'2ème plage
With Fe
Set Plage = .Range(.[B7], .[B65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next

'vide le ComboBox2 et le rempli
Fe.ComboBox2.Clear
For I = 1 To Col.Count
Fe.ComboBox2.AddItem Col(I)
Next I

Set Plage = Nothing
Set Col = Nothing

End Sub

Hervé.
"Jean-Paul V" denews: 4804038A-CABC-4805-964C-7D332CE99__BEGIN_MASK_n#9g02mG7!__...__EN D_MASK_i?a63jfAD$



Bonjour à tous

J'ai trouvé dans Excelabo un fichier de JB permettant grace à une C ombobox
de filtrer une Base de Donnée de plus 1000 éléments.
J'ai repris cette macro et je lui ai ajouté une deuxième Combobox, j'ai
besoin de filtrer un fichier articles classé par code , soit par code ,
soit

par désignation.
La macro modifiée donne :
Sub Auto_Open()
Set maliste = CreateObject("Scripting.Dictionary")
Set meslibel = CreateObject("Scripting.Dictionary")
For Each c In Range([A7], [A65000].End(xlUp))
If Not maliste.Exists(c.Value) Then maliste.Add c.Value, c.Value
Next c
For Each c In Range([B7], [B65000].End(xlUp))
If Not meslibel.Exists(c.Value) Then meslibel.Add c.Value, c.Value
Next c
Sheets(1).ComboBox1.List = maliste.items
Sheets(1).ComboBox2.List = meslibel.items
End Sub
Serait-il possible en ajoutant des instructions d'avoir les 2 objets
maliste

et meslibel classés ?

@+ J'espère- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



Jean-Paul V
Le #4672671
Merci Hervé

Je vais étudier votre solution (car j'apprends toujours en regardant les
différentes solutions ) mais celle de JB qui suit a l'air encore plus concise.


Bonsoitr Jean-Paul,
Regarde ce qui suit et adapte :
Sub Auto_Open()
Dim Fe As Object
Dim Col As New Collection
Dim Plage As Range
Dim I As Long

Set Fe = Feuil1 'nom dans VBE
'1ère plage
With Fe
Set Plage = .Range(.[A7], .[A65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next
'vide le ComboBox1 et le rempli
Fe.ComboBox1.Clear
For I = 1 To Col.Count
Fe.ComboBox1.AddItem Col(I)
Next I
'réinitialise la collection
Set Col = Nothing
'2ème plage
With Fe
Set Plage = .Range(.[B7], .[B65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next

'vide le ComboBox2 et le rempli
Fe.ComboBox2.Clear
For I = 1 To Col.Count
Fe.ComboBox2.AddItem Col(I)
Next I

Set Plage = Nothing
Set Col = Nothing

End Sub

Hervé.
"Jean-Paul V" de news:
Bonjour à tous

J'ai trouvé dans Excelabo un fichier de JB permettant grace à une Combobox
de filtrer une Base de Donnée de plus 1000 éléments.
J'ai repris cette macro et je lui ai ajouté une deuxième Combobox, j'ai
besoin de filtrer un fichier articles classé par code , soit par code ,
soit

par désignation.
La macro modifiée donne :
Sub Auto_Open()
Set maliste = CreateObject("Scripting.Dictionary")
Set meslibel = CreateObject("Scripting.Dictionary")
For Each c In Range([A7], [A65000].End(xlUp))
If Not maliste.Exists(c.Value) Then maliste.Add c.Value, c.Value
Next c
For Each c In Range([B7], [B65000].End(xlUp))
If Not meslibel.Exists(c.Value) Then meslibel.Add c.Value, c.Value
Next c
Sheets(1).ComboBox1.List = maliste.items
Sheets(1).ComboBox2.List = meslibel.items
End Sub
Serait-il possible en ajoutant des instructions d'avoir les 2 objets
maliste

et meslibel classés ?

@+ J'espère









Jean-Paul V
Le #4672651
Merci JB et bravo pour tous vos fichiers très pédagogiques !


Bonsoir,

http://boisgontierjacques.free.fr/fichiers/Filtre/FiltreAutoSup1000_2.xls

Sub Auto_Open()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range([A4], [A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Sheets(1).ComboBox1.List = MonDico.items
'---- par ville
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range([B4], [B65000].End(xlUp))
If Not MonDico2.Exists(c.Value) Then MonDico2.Add c.Value, c.Value
Next c
temp = MonDico2.items
Call tri(temp, LBound(temp), UBound(temp))
Sheets(1).ComboBox2.List = temp 'mondico2.items
End Sub

Sub tout()
On Error Resume Next
ActiveSheet.ShowAllData
End Sub

Sub tri(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

JB
http://boisgontierjacques.free.fr/

On 23 août, 20:57, "Hervé"
Bonsoitr Jean-Paul,
Regarde ce qui suit et adapte :
Sub Auto_Open()
Dim Fe As Object
Dim Col As New Collection
Dim Plage As Range
Dim I As Long

Set Fe = Feuil1 'nom dans VBE
'1ère plage
With Fe
Set Plage = .Range(.[A7], .[A65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next
'vide le ComboBox1 et le rempli
Fe.ComboBox1.Clear
For I = 1 To Col.Count
Fe.ComboBox1.AddItem Col(I)
Next I
'réinitialise la collection
Set Col = Nothing
'2ème plage
With Fe
Set Plage = .Range(.[B7], .[B65536].End(xlUp))
End With

On Error Resume Next
For I = 1 To Plage.Rows.Count
Col.Add Plage(I), CStr(Plage(I))
Next

'vide le ComboBox2 et le rempli
Fe.ComboBox2.Clear
For I = 1 To Col.Count
Fe.ComboBox2.AddItem Col(I)
Next I

Set Plage = Nothing
Set Col = Nothing

End Sub

Hervé.
"Jean-Paul V" denews: 4804038A-CABC-4805-964C-7D332CE99__BEGIN_MASK_n#9g02mG7!__...__END_MASK_i?a63jfAD$



Bonjour à tous

J'ai trouvé dans Excelabo un fichier de JB permettant grace à une Combobox
de filtrer une Base de Donnée de plus 1000 éléments.
J'ai repris cette macro et je lui ai ajouté une deuxième Combobox, j'ai
besoin de filtrer un fichier articles classé par code , soit par code ,
soit

par désignation.
La macro modifiée donne :
Sub Auto_Open()
Set maliste = CreateObject("Scripting.Dictionary")
Set meslibel = CreateObject("Scripting.Dictionary")
For Each c In Range([A7], [A65000].End(xlUp))
If Not maliste.Exists(c.Value) Then maliste.Add c.Value, c.Value
Next c
For Each c In Range([B7], [B65000].End(xlUp))
If Not meslibel.Exists(c.Value) Then meslibel.Add c.Value, c.Value
Next c
Sheets(1).ComboBox1.List = maliste.items
Sheets(1).ComboBox2.List = meslibel.items
End Sub
Serait-il possible en ajoutant des instructions d'avoir les 2 objets
maliste

et meslibel classés ?

@+ J'espère- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -








Publicité
Poster une réponse
Anonyme