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.



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 : 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
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.