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
| 'Nom de la Macro
Sub Rdm_lim()
'Déclaration des variable
Dim lim As Integer
Dim test As Range
Dim tot As Integer
Dim cell_des As Range
Dim flg As Boolean
Dim upperbound As Integer
'Set les variables prédéfinies aux valeurs souhaitées
i = 0
tot = 0
flg = False
'Créer une "InputBox" dans laquelle on place la valeur plafond que l'on enregistre dans "lim"
lim = InputBox("Insérer la valeur plafond", "Valeur plafond", 25)
'On défini la feuille dans laquelle on travaille
With Worksheets("test")
'On set les "Ranges" sur les cases que l'on veut
'test va balayer la colonne A
Set test = .Range("A1")
'cell_des est la cellule de destination
Set cell_des = .Range("D1")
'On cherche la dernière cellule non vide de la collone 1 (=> .Columns(1).Find("*", , , , xlByColumns, xlPrevious) )
'On récupère sa ligne (=> .Row )
'On enregistre celle-ci en soustrayant 1 dans upperbound
upperbound = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row - 1
'On boucle tant que "tot < lim" (=> voir "Loop While")
Do
'On créer un variable rdm comprise entre 0 et upperbound-1
rdm_test = Int((upperbound + 1) * Rnd)
'i est notre offset pour la cellule de destination
'Il y a donc deux parties => 1) i = 0 et l'on place la permière valeur dans la collone D
' => 2) i est différent de 0 (=> <> ) et il faut vérifier que la cellule que l'on va déplacer n'est pas déjà présente dans la collone D
'Première partie => i = 0
If i = 0 Then
'On place simplement la cellule test avec un offset de ligne "rdm_test" (je rappelle : compris entre 0 et le nombre de ligne -1)
'Je répond donc à ta question "Pourquoi -1" car si tu fais un offset du nombre de ligne exacte à la dernière cellule non vide, tu tombes sur la case d'après la dernière ligne : soit "rien"
cell_des.Offset(i, 0) = test.Offset(rdm_test, 0)
'On ajoute au total "tot", tot + la cellule à droite de la cellule déplacée
'On peut faire également "tot = test.Offset(rdm_test, 1)" directement
tot = tot + test.Offset(rdm_test, 1)
'On ajoute 1 à i puisque l'on a maintenant une valeur dans D
'Pareil : on aurait pu écrire "i = 1"
i = i + 1
'Deuxième partie => i > 0
Else
'Cette boucle va comparer la nouvelle cellule que l'on veut déplacer avec celles qui sont déjà présentes dans D
'On boucle donc sur toute la colonne D soit sur "D1" avec un offset de 0 au numéro de la dernière ligne "-1"
For j = 0 To .Columns(4).Find("*", , , , xlByColumns, xlPrevious).Row - 1
'On compare la valeur de la case rdm à celles sur D
'Si on trouve une valeur identique...
If cell_des.Offset(j, 0) = test.Offset(rdm_test, 0) Then
'... on pace notre flag (= drapeau) à "True"
flg = True
End If
Next j
'Si le flag est à "False", cela signifie que la cellule rdm que l'on veut déplacer n'est pas dans la colonne D
'Dans ce cas, on peut se permettre de la déplacer
If flg = False Then
'Ce que l'on fait ici
cell_des.Offset(i, 0) = test.Offset(rdm_test, 0)
'Puis de la même manière on ajoute le total de la cellule à droite de la cellule déplacée
tot = tot + test.Offset(rdm_test, 1)
'Et on incrémente i
i = i + 1
End If
'=> Si le flag était "True" on est pas rentré dans la boucle, donc rien n'a été déplacé, rien n'a été ajouté, on recommence, tout simplement
'On reset le flag à "False" dans le cas où il était passé à "True"
flg = False
End If
'Ceci est un complément :
'En effet, en effectuant des tests et en ayant placé une valeur "lim" beaucoup trop grande, la somme de toutes les valeurs à droite des cellules à déplacées est inférieur à "lim"
'Et si c'est le cas, on rentre dans un boucle infini dans laquelle le programme cherche une valeur différente de celle qu'il a déjà déplacé alors qu'elle l'on déjà toutes été
If i > upperbound Then
'J'affiche donc un message qui stipule qu'on a déjà déplacé toute les valeurs
MsgBox "Vous avez atteind la limite Max : il n'y a plus de possibilité d'unique valeur dans votre sélection."
'Et je sors de la boucle
Exit Do
End If
Loop While tot < lim
'Je place le total "tot" en bas de la colonne D
cell_des.Offset(i, 0) = tot
End With
End Sub |
