Discussion :

[User]

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

[Jean-Philippe André]

Salut,
Pas mal du tout ce code

[Arkham46]

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 une procédure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub liberer(c As Collection)
 
While c.Count > 0
c.Remove (1)
Wend
 
Set c = Nothing
 
End Sub

ben le set = nothing libère de la mémoire chaque élement de la collection

Essaye de remplir une collection avec des centaines de milliers d'éléments et regarde dans le gestionnaire des tâches => après le set = nothing la mémoire est libérée.
Idem si on met des objets de classe dans la collection, le release de chaque classe est bien exécuté sans avoir besoin de libérer les objets un à un (heureusement!)

[Jean-Philippe André]

Yep, perso je m'etais cree une pseudo fonction de "reinitialisation" de collection en enchainant un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

set c= Nothing

suivi d'un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

set c= New Collection

[Arkham46]

Yep, perso je m'etais cree une pseudo fonction de "reinitialisation" de collection en enchainant un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

set c= Nothing

suivi d'un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

set c= New Collection

si tu affectes une nouvelle collection à c, alors le compteur de réf de la précédente collection est décrémentée comme avec set = nothing qui est donc inutile devant un new collection

ça te fait gagner une ligne

[User]

Merci à vous deux

ok pour le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

set c=nothing

seul qui suffit à libérer la mémoire

Dans le même ordre d'idée, on peut également utiliser ce code pour copier une partie des éléments d'une collection dans une autre :

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
Function Copier(ByVal c1 As Collection, ByVal d As Long, ByVal l As Long) As Collection
On Error GoTo erreur_copier
 
Dim c2 As New Collection, i as long
 
For i = d To (l + d - 1)
c2.Add (c1.Item(i))
Next i
 
Set Copier = c2
 
Exit Function
erreur_copier:    ' Routine de gestion d'erreur.
    ' Évalue le numéro d'erreur.
    If Err.Number = 9 Then
 
       MsgBox ("revoir l'indice de début et le nombre d'éléments à copier !")
 
       Set c2 = Nothing ' libération
       Set Copier = New Collection ' renvoie une collection ne contenant aucun élément.
 
    End If
 
End Function

Que l'on peut utiliser comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set c2 = Copier(c1, 2, 4)

qui extrait 4 éléments de la collection c1 en commençant par le 2ème élément et les copie dans la collection c2.