Discussion :

[bitissa1991]

Bonjour les amis j'ai un code qui est réalisé par Thebenoit59 membre au forum et que je remercie beaucoup pour son aide pour le réussir et maintenant
je vous contacte pour faire des amélioration sur ce code

1) on faite je veux fixé le nombre de fois que je veux ma boucle tourne dans la celule B4
je veux que quand je clique sur le bouton simulation , que ma boucle tourne le nombre de fois que je vais lui fixé dans la cellule B4 (Nombre de boucle )

2)la 2 éme chose que je veux modifié svp dans mon code c'est :
-maintenant avant de cliqué dur le bouton simulation , les celulles B7:T7 sont vides
-quand on clique sur le bouton simulation la cellule B7 ce rempli et aprés 2 seconde la cellule C7 se rempli jusqu'a T7 et une fois que T7 est rempli la boucle pour remplire la colonne X se lance
- maintenant ce que je veux c'est que une fois que B7 est rempli on lance la boucle qui rempli la colonne X
merci :D


voila le code svp merci :

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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
 
'Forumeur : bitissa1991
'Auteur : TheBenoit59
'Lien : http://www.developpez.net/forums/d1586740/logiciels/microsoft-office/excel/macros-vba-excel/macro-recherche-aleatoire-conditions/#post8643065
 
 
 
Option Explicit
Option Base 1
 
Public Satisfait As Boolean
 
Sub Choix_Aleatoire()
Dim f As Worksheet: Set f = Sheets("Interface")
Dim r, a, c
Dim d As Object: Set d = CreateObject("scripting.dictionary")
Dim i As Integer, j As Integer, n As Integer
 
'On enregistre chaque ligne ayant la même clé
r = f.[H13:Q51]
For i = LBound(r) To UBound(r)
    d(r(i, 8)) = d(r(i, 8)) & i + 12 & ":"
Next i
 
'On boucle la colonne C
j = 13
Do While f.Cells(j, 3).Value <> ""
Recommence_la_boucle:
    'On vérifie que la valeur existe dans le dictionnaire sinon on quitte la procédure
    If Not d.exists(f.Cells(j, 3).Value) Then MsgBox f.Cells(j, 3).Value & " non trouvé dans la colonne O", 16: f.Cells(j, 3).Activate: Exit Sub
    'On remet les items dans un tableau
    a = Split(d(f.Cells(j, 3).Value), ":")
    'On choisit une ligne au hasard dans le tableau
    n = a(Int(((UBound(a) - 1) * Rnd)))
    'Revenir au début si la ligne ne peut pas rester positive
    If f.Cells(n, "i").Value - f.Cells(n, "k").Value < 0 Then GoTo Recommence_la_boucle
    'On calcule la valeur en colonne R et on remplace également en colonne I
    f.Cells(n, "r").Value = f.Cells(n, "i").Value - f.Cells(n, "k").Value
    f.Cells(n, "i").Value = f.Cells(n, "r").Value
    'On note le poste choisi en colonne F pour exemple
    f.Cells(j, "f").Value = "Ligne " & n
    'On incrémente et on boucle
    j = j + 1
Loop
    'Vérifie si toutes les valeurs ont été bouclées
    Satisfait = True
End Sub
 
Sub Plaque5_Cliquer()
Dim UniteLavage As Long
Dim d As Object
Dim i As Integer, j As Integer, c As Variant
Dim Nbre_Total_Boucl As Integer
Dim Rng1, Rng2 As Range
Dim Nb_Boucle As Integer
Dim Arret As Boolean
'Dim compt As Integer
'compt = 1
    Satisfait = False
    With Sheets("Interface")
 
        'On vérifie s'il existe une valeur en B1
        If .[b1] = "" Then MsgBox "Insérer une valeur en B1", 16: Exit Sub
        'On enregistre la variable UniteLavage
        UniteLavage = .[b1]
        'On applique la valeur à la ligne 7
 
 
'code pour le lancement des passe dans le tunel
    Arret = False: Nb_Boucle = 0
    'Do Until compt = 2
    If Range("B1").Value <> "" Then 'vérifie que B1 n'est pas vide
        Nbre_Total_Boucl = Columns(3).Find("*", , , , , xlPrevious).Row - 12
        Do While Arret = False
            DoEvents
            'Range("B7:T7").Value = "" 'réinitialise ton "tableau"
            i = 2 'valEUr de Ma première colonne du tableau
            Application.Wait Time + TimeSerial(0, 0, 2) 'attends 10 sec
 
            Do Until Range("T7") <> "" Or Arret = True 'conditionne la boucle jusqu'à la dernière colonne de ton tableau
 
                If i > 2 Then Cells(7, i - 1).Value = Range("B1") 'mettre la valeur de B1 dans les cellule precedente
                Cells(7, i).Value = Range("B1").Value 'mets ta valeurs dans la cellule de ton tableau
                i = i + 1 'prochaine colonne
                Application.Wait Time + TimeSerial(0, 0, 2) 'attends 10 sec
                DoEvents
            Loop
            Range("B3") = Range("B3") + Range("T7")
 
            'If Range("B7") <> "" Then
 
 
            'boucle sur la colonne X
            Set Rng1 = Columns(24).Cells.Find(Range("C13").Offset(Nb_Boucle, 0).Value)
 
            If Rng1 Is Nothing Then
                MsgBox Range("C13").Offset(Nb_Boucle, 0).Value & " non trouvé en colonne X"
           Else
            Rng1.Offset(1, 0).Value = Rng1.Offset(1, 0).Value + Range("B7").Value
            'End If
            End If
            Nb_Boucle = Nb_Boucle + 1
            If Nb_Boucle = Nbre_Total_Boucl Then Exit Do
        Loop
    Else
        MsgBox "B1 est vide !"
 
    End If
        '.Range("b7:t7").Value = UniteLavage
            'On démarre la procédure de choix aléatoire
            Choix_Aleatoire
            'Si Satisfait n'est pas atteint on quitte
            If Not Satisfait Then Exit Sub
        'On détermine la quantité de chaque Plat
        i = .[c65000].End(xlUp).Row
        Set d = CreateObject("scripting.dictionary")
            'On boucle la colonne C
            For j = 13 To i
                'On incrémente chaque Plat pour déterminer le nombre de chaque
                d(.Cells(j, 3).Value) = d(.Cells(j, 3).Value) + 1
            Next j
            For Each c In d.keys: d(c) = d(c) * UniteLavage: Next c
        'On boucle la colonne X
            'For j = 2 To 13 Step 2
            'If d.exists(.Cells(j, "x").Value) Then .Cells(j, "x").Offset(1).Value = d(.Cells(j, "x").Value)
           ' Next j
        'On ajoute la valeur à B1
        .[B3] = WorksheetFunction.Sum([x2:x13])
    End With
    'compt = compt + 1
 
End Sub