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
| '------------------------------------------------------------------------------------------------
Public Function TS_ValeurUnique(TS As Range, ByVal Colonne As Variant) As Variant
'------------------------------------------------------------------------------------------------
' Renvoie une liste sans doublon (valeur unique) en base 0 de la colonne d'un tableau structuré,
' classée par ordre croissant.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Une mémoire contenant les valeurs uniques où la première valeur est en index 0.
'------------------------------------------------------------------------------------------------
' Exemple pour obtenir les valeurs uniques d'après la colonne "Prénom" du
' tableau structuré nommé "Tableau1" :
'Dim V As Variant, i As Long
'V = TS_ValeurUnique(Range("Tableau1"), "Prénom")
'For i = 0 To UBound(V)
' Debug.Print V(i)
'Next i
'------------------------------------------------------------------------------------------------
Dim NomColonne As String, StrSQL As String
Dim i As Long, k As Long
Dim X() As Variant, V() As Variant
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError
' Charge les données de la colonne:
X = TS.ListObject.ListColumns(Colonne).DataBodyRange.Value
' Trie les données (en base 1):
Call TS_QuickSort(X(), 1, UBound(X))
' Renvoie les données sans doublon:
ReDim V(0 To UBound(X))
V(0) = X(1, 1)
For i = 1 To UBound(X)
If X(i, 1) <> V(k) Then k = k + 1: V(k) = X(i, 1):
Next i
ReDim Preserve V(0 To k)
' Renvoie les données sous forme de variable:
TS_ValeurUnique = V
' Fin du traitement:
Gest_Err:
' Fin du traitement:
If Err.Number <> 0 Then
MsgBox Err.Number & " : " & Err.Description, vbInformation, "TS_ValeurUnique"
End If
Err.Clear
End Function
'------------------------------------------------------------------------------------------------
Private Function TS_IndexColonne(TS As Range, ByVal Colonne As Variant) As Long
'------------------------------------------------------------------------------------------------
' Recherche le numéro de la colonne d'un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors renvoie le numéro de la dernière colonne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : Le numéro de la colonne dans le tableau,
' ou -1 si erreur.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
' S'il faut traiter la dernière colonne:
If Colonne = "" Or Colonne = 0 Then Colonne = TS.ListObject.ListColumns.Count
' Retrouve le numéro de la colonne si c'est le nom qui est passé en argument,
' une erreur est déclenchée si le nom n'existe pas:
If TypeName(Colonne) = "String" Then
Colonne = TS.ListObject.ListColumns(Colonne).Index
End If
' Contrôle la cohérence de la colonne passée en argument:
If Colonne < 0 Or Colonne > TS.ListObject.ListColumns.Count Then
TS_IndexColonne = -1
Else
TS_IndexColonne = Colonne
End If
' Fin du traitement:
Gest_Err:
Err.Clear
End Function
'----------------------------------------------------------------------------------------
Private Sub TS_QuickSort(ByRef TabDonnées() As Variant, ByVal Gauche As Long, ByVal Droite As Long)
'----------------------------------------------------------------------------------------
' Algorithme QuickSort optimisé pour trier un tableau.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Long, Temp As Variant, Pivot As Variant
i = Gauche
j = Droite
Pivot = TabDonnées((Gauche + Droite) / 2, 1)
Do
While Pivot > TabDonnées(i, 1): i = i + 1: Wend
While TabDonnées(j, 1) > Pivot: j = j - 1: Wend
If j + 1 > i Then
Temp = TabDonnées(i, 1)
TabDonnées(i, 1) = TabDonnées(j, 1)
TabDonnées(j, 1) = Temp
If LBound(TabDonnées, 2) = 0 Then
Temp = TabDonnées(i, 0)
TabDonnées(i, 0) = TabDonnées(j, 0)
TabDonnées(j, 0) = Temp
End If
j = j - 1: i = i + 1
End If
Loop Until i > j
If Gauche < j Then Call TS_QuickSort(TabDonnées(), Gauche, j)
If i < Droite Then Call TS_QuickSort(TabDonnées(), i, Droite)
End Sub
'----------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------- |
