Discussion :

[EricDev31]

Bonjour,

Dans une feuille de calcul j'ai de la cellule G9 à la cellule G21 des 0 et des 1 correspondants à l'inclusion ou non de certains types de produits.

Chaque modification d'un 1 ou d'un 0 influe sur un indicateur maison situé en d23.

L'idée est de parcourir ttes les possibilités de 0 et 1 afin de récupèrer la valeur max de l'indicateur et la combinaison correspondante.

J'ai programmé un truc affreux avec des boucles for imbriqués mais ça prend beaucoup trop de temps. Je suis sur qu'on peux faire quelque chose avec des nombre binaire mais je ne sais pas faire...

Pourriez vous me donner un petit coup de pouce ?

Merci,
Eric

[AlainTech]

Bonjour et bienvenue.

Dans la majorité des cas, quand il n'y a pas de réponse à une question c'est qu'elle est soit trop vague, soit pas accompagnée du code qui pose problème.

Je te propose donc de poster ce "truc affreux" pour qu'on t'aide à le rendre plus "joli".

[EricDev31]

Oublions le 'truc affreux', j'ai essayé d'adapter un code que j'ai trouvé, mais en vain.

Les données ont aussi changés: Je récapitule:

Un indicateur maison en d9 qui donne un note au scénario.
Une colonne (la 19 à partir de la ligne 12) dans lequel grace à des 0 et des 1 ont compte ou non des produits.
Le nombre de produits en b12.

L'idée : trouvez la meilleure possibilité !

Voilà le code :

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
Private Sub Optimisation_Click()
 
 
Dim mot As String, i, j, var$
 
Application.ScreenUpdating = False
 
'Ici je recupère le nombre de produits différents
longueur = Range("b12")
'La valeur maxi de mon indicateur est initialisé à 0
Max = 0
 
zeros = "0"
 
For a = 1 To longueur
    zeros = "0" & zeros
Next
 
    mot = "0"
    Do While Len(mot) <= longueur
        If InStr(mot, "0") <> 0 Then
            mot = Left(mot, InStr(mot, "0") - 1) & "1" & Right(mot, Len(mot) - InStr(mot, "0"))
            var = Right(zeros & mot, longueur)
            For j = 1 To longueur
                Cells(j + 12, 19) = Mid(var, j, 1)
                If Range("d9") > Max Then
                    Max = Range("d9")
                    For a = 1 To longueur
                        Cells(a, 200) = Cells(12 + a, 19)
                    Next
                End If
            Next
 
 
        Else
            mot = "1" & String(Len(mot), "0")
            var = Right(zeros & mot, longueur)
            For j = 1 To longueur
                Cells(j + 12, 19) = Mid(var, j, 1)
                If Range("d9") > Max Then
                    For b = 1 To longueur
                        Cells(b, 200) = Cells(12 + b, 19)
                    Next
                End If
            Next
 
        End If
    Loop
 
For c = 1 To longueur
    Cells(12 + c, 19) = Cells(c, 200)
Next
 
Application.ScreenUpdating = True
End Sub

C'est pas trop mal, quoi que un peu long lorsque le nombre de produit augmente.

Gros problème, il manque des combinaisons, donc on arrive à une meilleure optimisation à la main qu'avec la petite macro.

Bref je bidouille ce que je peux mais je suis une pince finie en vba.


Si vous êtes inspirés, merci d'avance,

Eric

[EricDev31]

Les hypothèses n'ont pas changés, voir le message précédent.

J'ai finalement une macro qui effectue ce que je veux, mais le problème est bien le temps d'éxecution.
Voilà le code:

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
36
37
38
Sub Optimisation_click()
 
Application.ScreenUpdating = False
 
'Récupération du nombre de lignes
nombredelignes = Range("b11")
 
'Remise à zéro
For a = 1 To nombredelignes
    Cells(12 + a, 19) = ""
Next
 
'2^n -1
lignes = -1 + 2 ^ nombredelignes
 
 
For i = 0 To lignes
bin = DecToBin(i)
    For j = 1 To Len(bin)
        Cells(12 + j, 19) = Mid(bin, j, 1)
        If Range("d9") > Max Then
            Max = Range("d9")
            For b = 1 To nombredelignes
                Cells(b, 200) = Cells(12 + b, 19)
            Next
        End If
    Next
Next
 
'Recupération de la meilleure combinaison
Range("d10") = Max
For c = 1 To nombredelignes
    Cells(12 + c, 19) = Cells(c, 200)
Next
 
Application.ScreenUpdating = False
 
End Sub

Avez vous des idées d'amélioration ?

Petite reflexion: lorsque la macro vient d'afficher 1 1 1 0 0 0 0, pour l'étape suivante, elle ré écrit 1 1 1 0 0 0 puis 1, en 'écrasant' les premieres valeurs qui finalement n'ont pas changés !
Il y a peut etre un moyen de faire ecrire uniquement les bits qui changent..

Je ne sais pas trop..
En espèrant que quelqu'un me réponde,

Merci d'avance,
Eric

[EricDev31]

Pas de réponse...