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
| Option Explicit
Private Sub UserForm_Initialize()
With Me.AffichageSelection
.View = lvwReport
.ColumnHeaders.Add , , "A", 50
.ColumnHeaders.Add , , "C", 50
.ColumnHeaders.Add , , "F", 50
.ColumnHeaders.Add , , "H", 50
.ColumnHeaders.Add , , "J", 50
.ColumnHeaders.Add , , "L", 50
End With
Worksheets("Projet").ListObjects("Tableau1").Range.AutoFilter
RemplirCmbo Me.ComboBox1, 8
RemplirCmbo Me.ComboBox2, 10
End Sub
Private Sub ComboBox1_Change()
RemplirLstview
End Sub
Private Sub ComboBox2_Change()
RemplirLstview
End Sub
'Permet de remplir sans doublons la combo Cbo à partir de la colonne Col
Private Sub RemplirCmbo(ByVal Cbo As Object, Col As Integer)
Dim MonDico As Object
Dim i As Long
Dim Tb
With Worksheets("Projet").ListObjects("Tableau1")
.Range.AutoFilter
Set MonDico = CreateObject("Scripting.Dictionary")
Tb = .DataBodyRange.Columns(Col).Value
End With
MonDico("ALL") = ""
For i = 1 To UBound(Tb)
If Tb(i, 1) <> "" Then MonDico(Tb(i, 1)) = ""
Next i
Tb = MonDico.keys
QuickSort Tb, 0, MonDico.Count - 1
Set MonDico = Nothing
With Cbo
.List = Tb
.ListIndex = 0
End With
End Sub
'Permet de remplir la listview prenant en compte le choix des combobox
Private Sub RemplirLstview()
Dim Plage As Range, c As Range
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
With Worksheets("Projet").ListObjects("Tableau1")
With .Range
.AutoFilter Field:=8, Criteria1:=IIf(Me.ComboBox1.Value = "ALL", "*", Me.ComboBox1.Value)
.AutoFilter Field:=10, Criteria1:=IIf(Me.ComboBox2.Value = "ALL", "*", Me.ComboBox2.Value)
End With
With .DataBodyRange
If WorksheetFunction.Subtotal(3, .Columns(1)) > 0 Then Set Plage = .Columns(1).SpecialCells(xlCellTypeVisible)
End With
If Not Plage Is Nothing Then
For Each c In Plage
With Me.AffichageSelection.ListItems.Add(, , c.Value)
.SubItems(1) = c.Offset(, 2)
.SubItems(2) = c.Offset(, 5)
.SubItems(3) = c.Offset(, 7)
.SubItems(4) = c.Offset(, 9)
.SubItems(5) = c.Offset(, 11)
End With
Next c
End If
Set Plage = Nothing
.Range.AutoFilter
End With
End Sub
'Tri rapide
Sub QuickSort(Tb, ByVal Mn As Long, ByVal Mx As Long)
Dim H As Long, L As Long, i As Long
Dim Tmp As String
If Mn >= Mx Then Exit Sub
i = Int((Mx - Mn + 1) * Rnd + Mn)
Tmp = Tb(i)
Tb(i) = Tb(Mn)
L = Mn
H = Mx
Do
Do While Tb(H) >= Tmp
H = H - 1
If H <= L Then Exit Do
Loop
If H <= L Then
Tb(L) = Tmp
Exit Do
End If
Tb(L) = Tb(H)
L = L + 1
Do While Tb(L) < Tmp
L = L + 1
If L >= H Then Exit Do
Loop
If L >= H Then
L = H
Tb(H) = Tmp
Exit Do
End If
Tb(H) = Tb(L)
Loop
QuickSort Tb, Mn, L - 1
QuickSort Tb, L + 1, Mx
End Sub |
