VBA-Recherche de valeur dans une collection

[job75]

Bonjour à tous,

Dans ce fil ouvert par Staple (pour ceux que ça intéresse) :

https://www.excel-downloads.com/thr...de-demandee-combinaisons-permutations.105753/

j'ai créé en VBA une collection nommée "combinaison" qui contient des nombres entiers.

Elle est évolutive, et avant de créer un élément de la collection, il me faut vérifier que sa valeur n'est pas encore utilisée dans la collection.

Pour cela, les valeurs de la collection sont copiées dans la feuille de calcul où je fais une recherche par la fonction CountIf (NB.SI).

Ma question : comment rechercher une valeur dans la collection sans utiliser la feuille de calcul ?

Merci d'avance.

A+

 

[skoobi]

Re : VBA-Recherche de valeur dans une collection

Bonjour job75 ,

Elle est évolutive, et avant de créer un élément de la collection, il me faut vérifier que sa valeur n'est pas encore utilisée dans la collection.

Cela revient à ne pas créer de doublon dans la collection.
Il suffit juste d'ajouter la "clé" à l'item que tu ajoutes en mettant une gestion d'erreur

On error Resume Next
combinaison.Add cl[B], cl[/B]
On error Goto 0

Add(Item, [Key], [Before], [After])

 

[job75]

Re : VBA-Recherche de valeur dans une collection

Re,

Merci beaucoup pour ton aide skoobi. J'ai adapté ta solution à la macro du fil de Staple, mais la collection "combinaison", même en l'initialisant, ne se crée pas. Tu peux voir ?

Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String, cl As Integer
Dim formule As New Collection, combinaison As New Collection
Range("A:A").ClearContents
op = Array("+", "-", "*", "/")
combinaison.Add 0
For x1 = 1 To 9
For x2 = 1 To 9
For x3 = 1 To 9
For x4 = 1 To 9
For o1 = 0 To 3
For o2 = 0 To 3
For o3 = 0 To 3

f1 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & x3 & op(o3) & x4
f2 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & ")" & op(o3) & x4
f3 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & "(" & x3 & op(o3) & x4 & ")"
f4 = "(" & x1 & op(o1) & x2 & op(o2) & x3 & ")" & op(o3) & x4
f5 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & op(o3) & x4 & ")"

If IsError(Evaluate(f1)) Then GoTo 1
If Abs(Evaluate(f1) - 24) < 10 ^ -13 Then
formule.Add f1
cl = classe(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, cl
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If

1 If IsError(Evaluate(f2)) Then GoTo 2
If Abs(Evaluate(f2) - 24) < 10 ^ -13 Then
formule.Add f2
cl = classe(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, cl
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If

2 If IsError(Evaluate(f3)) Then GoTo 3
If Abs(Evaluate(f3) - 24) < 10 ^ -13 Then
formule.Add f3
cl = classe(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, cl
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If

3 If IsError(Evaluate(f4)) Then GoTo 4
If Abs(Evaluate(f4) - 24) < 10 ^ -13 Then
formule.Add f4
cl = classe(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, cl
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If

4 If IsError(Evaluate(f5)) Then GoTo 5
If Abs(Evaluate(f5) - 24) < 10 ^ -13 Then
formule.Add f5
cl = classe(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, cl
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If

5 Next
Next
Next
Next
Next
Next
Next
MsgBox "Formules " & formule.Count
MsgBox "Combinaisons " & combinaison.Count - 1
End Sub

Function classe(x1, x2, x3, x4)
y1 = 1 * (x1 & x2 & x3 & x4)
y2 = 1 * (x1 & x2 & x4 & x3)
y3 = 1 * (x1 & x3 & x2 & x4)
y4 = 1 * (x1 & x3 & x4 & x2)
y5 = 1 * (x1 & x4 & x2 & x3)
y6 = 1 * (x1 & x4 & x3 & x2)
y7 = 1 * (x2 & x1 & x3 & x4)
y8 = 1 * (x2 & x1 & x4 & x3)
y9 = 1 * (x2 & x3 & x1 & x4)
y10 = 1 * (x2 & x3 & x4 & x1)
y11 = 1 * (x2 & x4 & x1 & x3)
y12 = 1 * (x2 & x4 & x3 & x1)
y13 = 1 * (x3 & x1 & x2 & x4)
y14 = 1 * (x3 & x1 & x4 & x2)
y15 = 1 * (x3 & x2 & x1 & x4)
y16 = 1 * (x3 & x2 & x4 & x1)
y17 = 1 * (x3 & x4 & x1 & x2)
y18 = 1 * (x3 & x4 & x2 & x1)
y19 = 1 * (x4 & x1 & x2 & x3)
y20 = 1 * (x4 & x1 & x3 & x2)
y21 = 1 * (x4 & x2 & x1 & x3)
y22 = 1 * (x4 & x2 & x3 & x1)
y23 = 1 * (x4 & x3 & x1 & x2)
y24 = 1 * (x4 & x3 & x2 & x1)
classe = Application.Min(y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, y21, y22, y23, y24)
End Function

A+

 

[skoobi]

Re : VBA-Recherche de valeur dans une collection

Re,

Arrfff, j'ai pas vu que "cl" est un nombre:

combinaison.Add cl, Cstr(cl)

Là ça doit être bon.

Bonne contribution

 

[job75]

Re : VBA-Recherche de valeur dans une collection

Re,

Merci beaucoup skoobi, ça marche parfaitement.

Je vais de ce pas modifier la macro sur le fil de Staple

A+