Optimisation de la rapidité d'une procedure

Version imprimable

Bonsoir,

Je suis retombé sur un fichier Excel relatif à un ancien sujet qui m'avait poussé à mettre un peu plus le nez dans la programmation.

selection-repartition-valeurs-colonnes

Je n'ai jamais vraiment su si c’était bien l'opération demandée à la base, mais peut importe.

J'explique un peu le problème.

On dispose d'une plage de cellule de 1000 lignes et 10 colonnes contenant aléatoirement A, B ou C

La procédure est la suivante.

On extrait 100 lignes parmi ces 1000 lignes de manière aléatoire.
On obtient donc un tableau de 100*10

Nous avons comme critère un Tableau de donnée qui indique les répartitions de chaque lettre à obtenir pour chacune des 10 lignes.

http://img11.hostingpics.net/pics/467297RRaa.jpg

Le but étant de trouver le plus rapidement un ensemble aléatoire de 100 lignes qui correspond au critères du tableau. Avec un Delta le plus faible possible.

J'ai modifié mon code pour le rendre plus performant.

Code:

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Sub TestRech2()
    Dim HDebut As Long
    Dim Haz As New Collection
    Dim i As Long
    Dim j As Integer
    Dim Delta As Integer
    Dim WS2 As Worksheet
    Dim PlageDebut()
    Dim LignesExtraites(100, 10)
    Dim Conditions()
    Dim RepartitionLE(10, 3)
    Dim rng As Range
    Dim Boucles As Long
 
    Set WS2 = ThisWorkbook.Worksheets("Feuil2")
    HDebut = CDec(Now)
    Application.ScreenUpdating = False
 
    'Transfert des données
    With WS2
        Delta = .Cells(14, 13)
        Set rng = .Range(.Cells(2, 13), .Cells(11, 15))
        Conditions = rng.Value
        PlageDebut() = .Range(.Cells(1, 1), .Cells(1000, 10))
    End With
1
    Boucles = Boucles + 1
    For i = 1 To 10
        For j = 1 To 3
             RepartitionLE(i, j) = 0
        Next j
    Next i
 
    'Tirage aléatoire de 100 lignes (Differentes)
    Do
        Randomize
        k = Int(Rnd * 1000 + 1)
        On Error Resume Next
        Haz.Add k, CStr(k)
        On Error GoTo 0
    Loop Until Haz.Count = 100
 
    For i = 1 To 100
        For j = 1 To 10
            LignesExtraites(i, j) = PlageDebut(Haz(i), j)
        Next j
    Next i
 
    ' Calcul apparition A,B,C par ligne
    For i = 1 To 10
        For j = 1 To 100
            Select Case LignesExtraites(j, i)
                Case Is = "A"
                     RepartitionLE(i, 1) = RepartitionLE(i, 1) + 1
                Case Is = "B"
                     RepartitionLE(i, 2) = RepartitionLE(i, 2) + 1
                Case Is = "C"
                     RepartitionLE(i, 3) = RepartitionLE(i, 3) + 1
            End Select
        Next j
    Next i
 
    'Evaluation des criteres
    For i = 1 To 10
        If RepartitionLE(i, 1) < Conditions(i, 1) + Delta And RepartitionLE(i, 1) > Conditions(i, 1) - Delta Then
            If RepartitionLE(i, 2) < Conditions(i, 2) + Delta And RepartitionLE(i, 2) > Conditions(i, 2) - Delta Then
                If RepartitionLE(i, 3) < Conditions(i, 3) + Delta And RepartitionLE(i, 3) > Conditions(i, 3) - Delta Then
                        If i = 10 Then
                            Application.ScreenUpdating = True
                            MsgBox "Solution apres " & Boucles & " boucles"
                            For j = 1 To 100
                                WS2.Cells(j, 17) = Haz(j)
                            Next j
                            Exit Sub
                        End If
                Else
                    Exit For
                End If
            Else
                Exit For
            End If
        Else
            Exit For
        End If
    Next i
 
    Set Haz = New Collection
    GoTo 1
 
End Sub

Ma question est la suivante : Quel sont les moyens de le rendre plus rapide ?

Merci d'avance pour vos suggestions.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
For i = 1 To 10
        If RepartitionLE(i, 1) < Conditions(i, 1) + Delta And RepartitionLE(i, 1) > Conditions(i, 1) - Delta Then
            If RepartitionLE(i, 2) < Conditions(i, 2) + Delta And RepartitionLE(i, 2) > Conditions(i, 2) - Delta Then
                If RepartitionLE(i, 3) < Conditions(i, 3) + Delta And RepartitionLE(i, 3) > Conditions(i, 3) - Delta Then
                        If i = 10 Then
                            Application.ScreenUpdating = True
                            MsgBox "Solution apres " & Boucles & " boucles"
                            For j = 1 To 100
                                WS2.Cells(j, 17) = Haz(j)
                            Next j
                            Exit Sub
                        End If
                Else
                    Exit For
                End If
            Else
                Exit For
            End If
        Else
            Exit For
        End If
    Next i

Ici je ne comprends pas trop cette belle usine à gaz!! Effectivement ta dernière condition pour entrer dans ta procédure et que i=10 sachant que c'est ta dernière valeur de ton FOR....
Donc déjà ici ya des grosses modifs à faire

Bien vu, je testais toutes mes conditions une par une, ce qui fait perdre du temps.

J'ai remplacé ce bloc par ceci :

Code:

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
    'Evaluation des criteres
 
 
    If RepartitionLE(1, 1) < Conditions(1, 1) + Delta And RepartitionLE(1, 1) > Conditions(1, 1) - Delta And RepartitionLE(2, 1) < Conditions(2, 1) + Delta And RepartitionLE(2, 1) > Conditions(2, 1) - Delta And _
        RepartitionLE(3, 1) < Conditions(3, 1) + Delta And RepartitionLE(3, 1) > Conditions(3, 1) - Delta And RepartitionLE(4, 1) < Conditions(4, 1) + Delta And RepartitionLE(4, 1) > Conditions(4, 1) - Delta And _
        RepartitionLE(5, 1) < Conditions(5, 1) + Delta And RepartitionLE(5, 1) > Conditions(5, 1) - Delta And RepartitionLE(6, 1) < Conditions(6, 1) + Delta And RepartitionLE(6, 1) > Conditions(6, 1) - Delta And _
        RepartitionLE(7, 1) < Conditions(7, 1) + Delta And RepartitionLE(7, 1) > Conditions(7, 1) - Delta And RepartitionLE(8, 1) < Conditions(8, 1) + Delta And RepartitionLE(8, 1) > Conditions(8, 1) - Delta And _
        RepartitionLE(9, 1) < Conditions(9, 1) + Delta And RepartitionLE(9, 1) > Conditions(9, 1) - Delta And RepartitionLE(10, 1) < Conditions(10, 1) + Delta And RepartitionLE(10, 1) > Conditions(10, 1) - Delta And _
        RepartitionLE(1, 2) < Conditions(1, 2) + Delta And RepartitionLE(1, 2) > Conditions(1, 2) - Delta And RepartitionLE(2, 2) < Conditions(2, 2) + Delta And RepartitionLE(2, 2) > Conditions(2, 2) - Delta And _
        RepartitionLE(3, 2) < Conditions(3, 2) + Delta And RepartitionLE(3, 2) > Conditions(3, 2) - Delta And RepartitionLE(4, 2) < Conditions(4, 2) + Delta And RepartitionLE(4, 2) > Conditions(4, 2) - Delta And _
        RepartitionLE(5, 2) < Conditions(5, 2) + Delta And RepartitionLE(5, 2) > Conditions(5, 2) - Delta And RepartitionLE(6, 2) < Conditions(6, 2) + Delta And RepartitionLE(6, 2) > Conditions(6, 2) - Delta And _
        RepartitionLE(7, 2) < Conditions(7, 2) + Delta And RepartitionLE(7, 2) > Conditions(7, 2) - Delta And RepartitionLE(8, 2) < Conditions(8, 2) + Delta And RepartitionLE(8, 2) > Conditions(8, 2) - Delta And _
        RepartitionLE(9, 2) < Conditions(9, 2) + Delta And RepartitionLE(9, 2) > Conditions(9, 2) - Delta And RepartitionLE(10, 2) < Conditions(10, 3) + Delta And RepartitionLE(10, 2) > Conditions(10, 2) - Delta And _
        RepartitionLE(1, 3) < Conditions(1, 3) + Delta And RepartitionLE(1, 3) > Conditions(1, 3) - Delta And RepartitionLE(2, 3) < Conditions(2, 3) + Delta And RepartitionLE(2, 3) > Conditions(2, 3) - Delta And _
        RepartitionLE(3, 3) < Conditions(3, 3) + Delta And RepartitionLE(3, 3) > Conditions(3, 3) - Delta And RepartitionLE(4, 3) < Conditions(4, 3) + Delta And RepartitionLE(4, 3) > Conditions(4, 3) - Delta And _
        RepartitionLE(5, 3) < Conditions(5, 3) + Delta And RepartitionLE(5, 3) > Conditions(5, 3) - Delta And RepartitionLE(6, 3) < Conditions(6, 3) + Delta And RepartitionLE(6, 3) > Conditions(6, 3) - Delta And _
        RepartitionLE(7, 3) < Conditions(7, 3) + Delta And RepartitionLE(7, 3) > Conditions(7, 3) - Delta And RepartitionLE(8, 3) < Conditions(8, 3) + Delta And RepartitionLE(8, 3) > Conditions(8, 3) - Delta And _
        RepartitionLE(9, 3) < Conditions(9, 3) + Delta And RepartitionLE(9, 3) > Conditions(9, 3) - Delta And RepartitionLE(10, 3) < Conditions(10, 3) + Delta And RepartitionLE(10, 3) > Conditions(10, 3) - Delta Then
 
            Application.ScreenUpdating = True
            MsgBox "Solution apres " & Boucles & " boucles"
            For j = 1 To 100
                WS2.Cells(j, 17) = Haz(j)
            Next j
            Exit Sub
    Else
        Set Haz = New Collection
        GoTo 1
    End If

Tester toutes les conditions en meme temps.

Une suppression de boucle inutile en passant

Code:

1
2
3
4
5
    For i = 1 To 10
        For j = 1 To 3
             RepartitionLE(i, j) = 0
        Next j
    Next i

Par cette ligne

Code:

Erase RepartitionLE