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 :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
set c2= c1
La variable c2 ne fais que pointer sur c1

et si je fais :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
c2.Remove(1)
cela va aussi supprimer le 1er élément de la collection c1.

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 :


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
Qui peux alors s'employer comme ceci :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
 
Set c2 = Cloner(c1)
Et alors :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
c2.Remove(1)
Supprime le 1er élément de c2 mais pas de c1.

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