FiltreAutoSup1000

Hervé

23/08/2007 à 20:57

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" a écrit dans le message
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

23/08/2007 à 21:39

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é" wrote:

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" a écrit dans le mes sage
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 -

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é" <hmsilve-sans...@wanadoo.fr> wrote:

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" <JeanPa...@discussions.microsoft.com> a écrit dans le mes sage
denews: 4804038A-CABC-4805-964C-7D332CE99__BEGIN_MASK_n#9g02mG7!__...__EN D_MASK_i?a63jfAD$z__@microsoft.com...

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 -

Vous avez filtré cet utilisateur ! Consultez son message

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é" wrote:

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" a écrit dans le mes sage
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

24/08/2007 à 06:36

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" a écrit dans le message
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

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" <JeanPaulV@discussions.microsoft.com> a écrit dans le message
de news: 4804038A-CABC-4805-964C-7D332CE99263@microsoft.com...

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

24/08/2007 à 06:38

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é" wrote:
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" a écrit dans le message
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 -

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é" <hmsilve-sans...@wanadoo.fr> wrote:

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" <JeanPa...@discussions.microsoft.com> a écrit dans le message
denews: 4804038A-CABC-4805-964C-7D332CE99__BEGIN_MASK_n#9g02mG7!__...__END_MASK_i?a63jfAD$z__@microsoft.com...

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 -

Vous avez filtré cet utilisateur ! Consultez son message

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é" wrote:
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" a écrit dans le message
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 -

FiltreAutoSup1000

4 réponses

Veuillez sélectionner un problème