1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
| Dim f
'##################################################
Private Sub ListBox1_Change()
Dim T()
Dim cpt& ' compteur
'---
ListBox2.Clear
ListView1.ListItems.Clear
'---
For k = 0 To ListBox1.ListCount - 1
If Me.ListBox1.Selected(k) = True Then
For Each c In Range(f.[I2], f.[I65000].End(xlUp))
If c = ListBox1.List(k, 0) Then
If c.Offset(0, -1) = ComboBox1 And c.Offset(0, 2) = ComboBox2 And c.Offset(0, -5) = ComboBox3 Then
cpt& = cpt& + 1
ReDim Preserve T(1 To 2, 1 To cpt&)
T(1, cpt&) = c.Offset(, 1)
T(2, cpt&) = c.Row 'renseigne la 2ème colonne du N° de ligne dans Excel pour pouvoir l'utiliser par la suite
End If
End If
Next c
End If
Next k
'---
If cpt& = 1 Then
ListBox2.AddItem T(1, 1)
ListBox2.List(ListBox2.ListCount - 1, 1) = T(2, 1)
ElseIf cpt& > 1 Then
ListBox2.List = Application.WorksheetFunction.Transpose(T)
Else
ListView1.ListItems.Clear
End If
End Sub
Private Sub ListBox2_Change()
Dim R As Range
Dim var
Dim Lig&
Dim j&
Dim k&
'---
With ListView1
.ListItems.Clear
.View = lvwReport
.FullRowSelect = True
.Gridlines = True
.HideColumnHeaders = False
End With
'---
For k& = 0 To ListBox2.ListCount - 1
'/// C'est ic qu'on utilise le N° de ligne dans Excel ///
Lig& = ListBox2.List(k&, 1)
Set R = f.Range("AE" & Lig& & ":AR" & Lig& & "")
var = R
'////////////////////////////////////////////////////////
With ListView1
If var(1, 1) = "" Then var(1, 1) = "na"
.ListItems.Add , , var(1, 1)
For j& = 2 To UBound(var, 2)
If var(1, j&) = "" Then var(1, j&) = "na"
.ListItems(.ListItems.Count).ListSubItems.Add , , var(1, j&)
Next j&
End With
Next k&
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Me.ComboBox1.SetFocus
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("H2:H" & [H65000].End(xlUp).Row)
mondico(c.Value) = ""
Next c
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox1.List = temp
'---
With Me.ListBox2
.BoundColumn = 1
.ColumnCount = 2
.ColumnWidths = "1cm;0cm" 'la 2ème colonne est cachée (0cm)
End With
'--- Titres de ListView1 ---
With Me.ListView1
.HideColumnHeaders = True
With .ColumnHeaders
.Add , , "1st T200", 45, lvwColumnLeft
.Add , , "1st DMU3", 45, 2
.Add , , "1st T500", 45, 2
.Add , , "1st Relea", 45, 2
.Add , , "Act T200", 45, 2
.Add , , "Act DMU3", 45, 2
.Add , , "Act T500", 45, 2
.Add , , "Act Relea", 45, 2
.Add , , "eS T100", 45, 2
.Add , , "eS T200", 45, 2
.Add , , "eS T400", 45, 2
.Add , , "eS T500", 45, 2
.Add , , "eS T700", 45, 2
.Add , , "eS Need", 45, 2
End With
End With
End Sub
'##################################################
Private Sub CommandButton1_Click()
Me.ComboBox1.Clear
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ListBox1.Clear
Me.ListBox2.Clear
UserForm_Initialize
End Sub
Private Sub CommandButton2_Click()
Unload MyUserForm
End Sub
Private Sub ComboBox1_click()
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ListBox1.Clear
Me.ListBox2.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("H2:H" & [H65000].End(xlUp).Row)
If c = Me.ComboBox1 Then mondico(c.Offset(0, 3).Value) = ""
Next c
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox2.List = temp
End Sub
Private Sub ComboBox2_click()
Me.ComboBox3.Clear
Me.ListBox1.Clear
Me.ListBox2.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("D2:D" & [D65000].End(xlUp).Row)
If c.Offset(, 4) = Me.ComboBox1 And c.Offset(, 7) = Me.ComboBox2 Then mondico(c.Value) = ""
Next c
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox3.List = temp
End Sub
Private Sub ComboBox3_click()
Me.ListBox1.Clear
Me.ListBox2.Clear
Set mondico = CreateObject("Scripting.Dictionary")
i = 0
For Each c In Range("I2:I" & [I65000].End(xlUp).Row)
If c.Offset(, -1) = Me.ComboBox1 And c.Offset(, 2) = Me.ComboBox2 And c.Offset(, -5).Value = Me.ComboBox3 Then
mondico(c.Value) = ""
Me.ListBox1.AddItem c
i = i + 1
End If
Next c
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ListBox1.List = temp
Me.ListBox1.MultiSelect = fmMultiSelectMulti
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 |