Dim cell As Range
Option Base 1
Private Sub CommandButton1_Click()
C1 = "": C2 = "": C3 = ""
End Sub
Private Sub UserForm_Initialize()
Dim aa As Variant, bb As Variant, cc As Variant
With Sheets("BDD0")
cc = .Range("C2:C" & .Range("C65536").End(xlUp).Row)
C3.List = cc
End With
With L1
With .ColumnHeaders
.Clear
.Add , , "LIGNE° PI", 60
.Add , , "ZONE", 60, 2
.Add , , "ADRESSE", 60, 2
.Add , , "CANTON", 100, 2
.Add , , "TYPE", 50, 2
.Add , , "COORDONNEES", 80, 2
.Add , , "Localisation", 90, 2
End With
.View = lvwReport
.FullRowSelect = False
End With
Call listeA
Call listeB
Call listeC
End Sub
Private Sub C3_Change()
Call MajListe
End Sub
Private Sub C2_Change()
Call MajListe
End Sub
Private Sub C1_Change()
Call MajListe
End Sub
Sub MajListe()
Dim aa As Variant, bb As Variant, i&, fin&
fin = Feuil1.Range("A65536").End(xlUp).Row
aa = Feuil1.Range("A2:H" & fin)
L1.ListItems.Clear
If C1 = "" And C2 = "" And C3 = "" Then GoTo 9
If C1 <> "" And C2 = "" And C3 = "" Then GoTo 1
If C2 <> "" And C1 = "" And C3 = "" Then GoTo 2
If C3 <> "" And C1 = "" And C2 = "" Then GoTo 3
If C1 <> "" And C2 <> "" And C3 = "" Then GoTo 4
If C1 <> "" And C3 <> "" And C2 = "" Then GoTo 5
If C2 <> "" And C3 <> "" And C1 = "" Then GoTo 6
If C1 <> "" And C2 <> "" And C3 <> "" Then GoTo 7
1 For i = 1 To UBound(aa)
If CStr(C1) = aa(i, 1) Then aa(i, 8) = "oui"
Next i
GoTo 8
2 For i = 1 To UBound(aa)
If CStr(C2) = aa(i, 2) Then aa(i, 8) = "oui"
Next i
GoTo 8
3 For i = 1 To UBound(aa)
If CStr(C3) = aa(i, 3) Then aa(i, 8) = "oui"
Next i
GoTo 8
4 For i = 1 To UBound(aa)
If CStr(C1) = aa(i, 1) And CStr(C2) = aa(i, 2) Then aa(i, 8) = "oui"
Next i
GoTo 8
5 For i = 1 To UBound(aa)
If CStr(C1) = aa(i, 1) And CStr(C3) = aa(i, 3) Then aa(i, 8) = "oui"
Next i
GoTo 8
6 For i = 1 To UBound(aa)
If CStr(C2) = aa(i, 2) And CStr(C3) = aa(i, 3) Then aa(i, 8) = "oui"
Next i
GoTo 8
7 For i = 1 To UBound(aa)
If CStr(C1) = aa(i, 1) And CStr(C2) = aa(i, 2) And CStr(C3) = aa(i, 3) Then aa(i, 8) = "oui"
Next i
8
y = 1
For i = 1 To UBound(aa)
If aa(i, 8) = "oui" Then y = y + 1
Next
If y < 2 Then GoTo 9
ReDim bb(y - 1, 7)
y = 1
For i = 1 To UBound(aa)
If aa(i, 8) = "oui" Then
For a = 1 To 7
bb(y, a) = aa(i, a)
Next a
y = y + 1
End If
Next i
With L1
.ListItems.Clear
.View = lvwReport
.FullRowSelect = True
.Gridlines = True
For i = 1 To UBound(bb)
.ListItems.Add , , bb(i, 1)
For a = 2 To UBound(bb, 2)
.ListItems(.ListItems.Count).ListSubItems.Add , , bb(i, a)
Next a
Next i
End With
9
End Sub
Sub listeA()
Dim MonDico As Object, c As Range, f As Worksheet
Set f = Feuil1
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A2", f.Range("A65000").End(xlUp))
MonDico(c.Value) = c.Value
Next c
C1.List = Application.Transpose(MonDico.keys)
End Sub
Sub listeB()
Dim MonDico As Object, c As Range, f As Worksheet
Set f = Feuil1
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("B2", f.Range("B65000").End(xlUp))
MonDico(c.Value) = c.Value
Next c
C2.List = Application.Transpose(MonDico.keys)
End Sub
Sub listeC()
Dim MonDico As Object, c As Range, f As Worksheet
Set f = Feuil1
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("C2", f.Range("C65000").End(xlUp))
MonDico(c.Value) = c.Value
Next c
C3.List = Application.Transpose(MonDico.keys)
End Sub