Bonjour,
Dans certains cas il est préférable d'utiliser un objet Collection au lieu des tableaux classiques :
Par exemple, lorsque l'on souhaite supprimer ou ajouter un éléments dans un tableau ce n'est jamais simple et l'objet Collection qui dispose des méthode Remove et Add est alors préférable.
Cependant, quand on veut réaliser des procédure un peu complexe, comme déterminer les arrangements ou les combinaisons de m éléments parmi n, on a besoin de copier dans une nouvelle collection la totalité de ses éléments. Ce pose alors le problème de l'affectation de ce genre d'objet .
En effet, si c1 et c2 sont 2 objets Collection et si je fais :
La variable c2 ne fais que pointer sur c1
Code : Sélectionner tout - Visualiser dans une fenêtre à part set c2= c1
et si je fais :
cela va aussi supprimer le 1er élément de la collection c1.
Code : Sélectionner tout - Visualiser dans une fenêtre à part c2.Remove(1)
Je propose donc de réaliser, avec une fonction VBA, une copie, ou un clone c2 de c1. Cette collection c2 contiendra donc les mêmes éléments que c1 en double :
Qui peux alors s'employer comme ceci :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12 Function Cloner(ByVal c1 As Collection) As Collection Dim c2 As Collection, value As Variant Set c2 = New Collection For Each value In c1 c2.Add (value) Next value Set Cloner = c2 End Function
Et alors :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Set c2 = Cloner(c1)
Supprime le 1er élément de c2 mais pas de c1.
Code : Sélectionner tout - Visualiser dans une fenêtre à part c2.Remove(1)
Cependant, cette fonction alloue à chaque fois de la mémoire, n'oublions donc pas de libérer la mémoire utilisée par ces objets à la fin avec un :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Set c = Nothing
Application à la détermination des arrangements de m éléments parmi n :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Public Sub Arrangement(c1 As Collection, c2 As Collection, n As Long) ' Procédure récursive qui donne la liste des arrangements de n éléments pris parmi les éléments de la liste de départ c1. Dim i As Long Dim col1 As Collection, col2 As Collection If n > 0 Then ' Si le nombre d'éléments encore à tirer est > 0. For i = 1 To c1.Count ' Parcours la liste des éléments. Set col1 = Cloner(c1) ' clone la collection. col1.Remove (i) ' supprime l'élément de la collection d'origine. Set col2 = Cloner(c2) ' clone la collection. col2.Add (c1.Item(i)) ' Ajoute l'élément à la nouvelle collection. Arrangement col1, col2, n - 1 ' appel de la procédure avec ces 2 nouvelles collection set col1 =Nothing' Libère la mémoire set col2 = Nothing Next i Else u = c2.Item(1) For i = 2 To c2.Count u = u & "," & c2.Item(i) Next i Debug.Print u ' affiche un arrangement. End If End Sub
La procédure de test :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 Public Function Tester() ' Teste les arrangements de 2 éléments parmi 3. Dim c1 As Collection, c2 As Collection Set c1 = New Collection ' Elle contient de tous les éléments (3) Set c2 = New Collection ' Elle contient les groupes de 2 éléments. c1.Add ("A"): c1.Add ("B"): c1.Add ("C") ' Ajoute 3 élément à l'objet collection Arrangement c1, c2, 2 ' génère tous les arrangements de 2 éléments parmi les 3. set c1 = Nothing set c2 = Nothing End Function
Partager