encore et toujours un problème de liste en cascade

Ange Ounis

06/11/2006 à 18:38

Une procédure pour faire ce travail :

http://frederic.sigonneau.free.fr/code/Objets/ValUniquesPlageTrieesCombo.txt

----------
Ange Ounis
----------

JB

06/11/2006 à 21:48

Bonsoir,

Elimination de doublons:

http://cjoint.com/?lgvVgL47F2

Private Sub UserForm_Initialize()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range([A2], [A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp)) ' voir module mod_tri
Me.ComboBox1.List = temp
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

-Pour listes en cascade,voir onglet choixServiceBD
-Pour récup autre fichier fermé,voir ADO

JB

Bonsoir,

Elimination de doublons:

http://cjoint.com/?lgvVgL47F2

Private Sub UserForm_Initialize()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range([A2], [A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp)) ' voir module mod_tri
Me.ComboBox1.List = temp
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

-Pour listes en cascade,voir onglet choixServiceBD
-Pour récup autre fichier fermé,voir ADO

JB

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir,

Elimination de doublons:

http://cjoint.com/?lgvVgL47F2

Private Sub UserForm_Initialize()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range([A2], [A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp)) ' voir module mod_tri
Me.ComboBox1.List = temp
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

-Pour listes en cascade,voir onglet choixServiceBD
-Pour récup autre fichier fermé,voir ADO

JB

francois63000

07/11/2006 à 10:22

OK merci pour ces solution. mais mon probleme se situe plus au niveau de la
récupération des données qui sont dans un autre fichier("répertoire") . Le
fichier est ouvert en meme temps que mon fichier sur lequel je travaille.
Mais quand je rentre ([A2],[A65000].end(XLup)) il ne récupère pas les données
de l'autre fichier maiscelle du fichier sur lequel je travaille.

Est il possible de modifier cette formule?

PS: JB qu'entend tu par "voir ADO" j'ai pas touver sur ton fichier
quelquechose qui pourrais correspondre à ça.

MErci

isabelle

07/11/2006 à 10:38

bonjour Francois,

With Workbooks("zaza.xls").Sheets("zz")
For Each c In .Range("A1:A" & .Range("A65536").End(xlUp).Row)
'action
next
End With

isabelle

JB

07/11/2006 à 22:03

Exemple de liste sans doublons et en cascade dans un UserForm:

http://cjoint.com/?lhwciIduZG

Private Sub UserForm_Initialize()
Me.ChoixSociété.List = SansDoublonsDictionnaire([société])
End Sub

Private Sub ChoixSociété_Change()
Me.Contacts.Clear
For Each c In [société]
If c = Me.ChoixSociété Then
Me.Contacts.AddItem c.Offset(0, 1)
End If
Next c
End Sub

Function SansDoublonsDictionnaire(champ)
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In champ
If c.Value <> "" Then
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
End If
Next c
'-- transfert dans un tableau
temp = MonDico.items
Call tri(temp, LBound(temp), UBound(temp))
SansDoublonsDictionnaire = Application.Transpose(temp)
End Function

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

Exemple de liste sans doublons et en cascade dans un UserForm:

http://cjoint.com/?lhwciIduZG

Private Sub UserForm_Initialize()
Me.ChoixSociété.List = SansDoublonsDictionnaire([société])
End Sub

Private Sub ChoixSociété_Change()
Me.Contacts.Clear
For Each c In [société]
If c = Me.ChoixSociété Then
Me.Contacts.AddItem c.Offset(0, 1)
End If
Next c
End Sub

Function SansDoublonsDictionnaire(champ)
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In champ
If c.Value <> "" Then
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
End If
Next c
'-- transfert dans un tableau
temp = MonDico.items
Call tri(temp, LBound(temp), UBound(temp))
SansDoublonsDictionnaire = Application.Transpose(temp)
End Function

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

Vous avez filtré cet utilisateur ! Consultez son message

Exemple de liste sans doublons et en cascade dans un UserForm:

http://cjoint.com/?lhwciIduZG

Private Sub UserForm_Initialize()
Me.ChoixSociété.List = SansDoublonsDictionnaire([société])
End Sub

Private Sub ChoixSociété_Change()
Me.Contacts.Clear
For Each c In [société]
If c = Me.ChoixSociété Then
Me.Contacts.AddItem c.Offset(0, 1)
End If
Next c
End Sub

Function SansDoublonsDictionnaire(champ)
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In champ
If c.Value <> "" Then
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
End If
Next c
'-- transfert dans un tableau
temp = MonDico.items
Call tri(temp, LBound(temp), UBound(temp))
SansDoublonsDictionnaire = Application.Transpose(temp)
End Function

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

JB

08/11/2006 à 04:32

Liste sans doublons et listes en cascade avec ADO:

http://cjoint.com/?lieFJRoGWC

Les 2 fichiers CascadeADO1.XLS et CascadeADO2.XLS sont dans le même
répertoire:

Private Sub UserForm_Initialize()
' dans Outils/Références cocher
' Microsoft ActivexDataObject 2.8 Library
ChDir ActiveWorkbook.Path
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver
(*.xls)};DBQ�scadeADO2.XLS"
Set rs = cnn.Execute("SELECT Société FROM BDListe GROUP BY
Société")
Do While Not rs.EOF
Me.ChoixSociété.AddItem rs("Société")
rs.MoveNext
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

Private Sub ChoixSociété_Change()
Me.Contacts.Clear
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver
(*.xls)};DBQ�scadeADO2.XLS"
Set rs = cnn.Execute("SELECT Contact FROM BDListe WHERE société='"
& Me.ChoixSociété & "' ORDER BY contact")
Do While Not rs.EOF
Me.Contacts.AddItem rs("Contact")
rs.MoveNext
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

JB

Liste sans doublons et listes en cascade avec ADO:

http://cjoint.com/?lieFJRoGWC

Les 2 fichiers CascadeADO1.XLS et CascadeADO2.XLS sont dans le même
répertoire:

Private Sub UserForm_Initialize()
' dans Outils/Références cocher
' Microsoft ActivexDataObject 2.8 Library
ChDir ActiveWorkbook.Path
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver
(*.xls)};DBQ=CascadeADO2.XLS"
Set rs = cnn.Execute("SELECT Société FROM BDListe GROUP BY
Société")
Do While Not rs.EOF
Me.ChoixSociété.AddItem rs("Société")
rs.MoveNext
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

Private Sub ChoixSociété_Change()
Me.Contacts.Clear
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver
(*.xls)};DBQ=CascadeADO2.XLS"
Set rs = cnn.Execute("SELECT Contact FROM BDListe WHERE société='"
& Me.ChoixSociété & "' ORDER BY contact")
Do While Not rs.EOF
Me.Contacts.AddItem rs("Contact")
rs.MoveNext
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

JB

Vous avez filtré cet utilisateur ! Consultez son message

Liste sans doublons et listes en cascade avec ADO:

http://cjoint.com/?lieFJRoGWC

Les 2 fichiers CascadeADO1.XLS et CascadeADO2.XLS sont dans le même
répertoire:

Private Sub UserForm_Initialize()
' dans Outils/Références cocher
' Microsoft ActivexDataObject 2.8 Library
ChDir ActiveWorkbook.Path
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver
(*.xls)};DBQ�scadeADO2.XLS"
Set rs = cnn.Execute("SELECT Société FROM BDListe GROUP BY
Société")
Do While Not rs.EOF
Me.ChoixSociété.AddItem rs("Société")
rs.MoveNext
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

Private Sub ChoixSociété_Change()
Me.Contacts.Clear
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver
(*.xls)};DBQ�scadeADO2.XLS"
Set rs = cnn.Execute("SELECT Contact FROM BDListe WHERE société='"
& Me.ChoixSociété & "' ORDER BY contact")
Do While Not rs.EOF
Me.Contacts.AddItem rs("Contact")
rs.MoveNext
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

JB

encore et toujours un problème de liste en cascade

6 réponses

Veuillez sélectionner un problème