Discussion :

[Trooper2]

Bonjour à tous,

J'ai écrit un petit script qui me permet de remplir un nombre de croix choisi, aléatoirement dans un tableau de 10*10 sur Excel, voila le script.

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
Private Sub TAL_Click()
 
      Dim Number, Digits, MyString, check, EA, Lim
 
Worksheets("Tableau").Range("b2:k11").Interior.ColorIndex = 7
 
calcul:
 
Range("b2:k11").Formula = "=rand()*100"
 
check = [M3]
If check >= 100 Then check = 100
If check <= 0 Then check = 0
 
        For rwIndex = 2 To 11
            For colIndex = 2 To 11
 
 With Worksheets("Tableau").Cells(rwIndex, colIndex)
 
 
If .Value < check Then .Value = "X" Else .Value = ""
 
  End With
Next colIndex
Next rwIndex
 
If [B13] <> check Then GoTo calcul Else GoTo fin:
 
GoTo fin:

Je me rend compte qu'il est archaïque mais cela fonctionne.
Mon petit souci est de savoir comment l'améliorer pour qu'il ne prenne pas 1 minute à me trouver une combinaison. En fait il cherche jusqu'à temp qu'il trouve le nombre de croix voulues. Cela peut prendre 3 secondes à 3 minutes.

Merci d'avance

[SilkyRoad]

bonsoir

tu peux tester cette procedure

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
Sub remplissageAleatoire()
Dim Tableau()
Dim Cell As Range
Dim nbCroix As Integer, i As Integer, j As Integer
 
Range("B2:K11").ClearContents
Range("B2:K11").Interior.ColorIndex = 7
 
nbCroix = 100 'valeur entre 0 et 100
 
For Each Cell In Range("B2:K11")
    i = i + 1
    ReDim Preserve Tableau(i)
    Tableau(i - 1) = Cell.Address
Next Cell
 
 
For j = 0 To nbCroix - 1
Randomize
DoEvents
Range(Tableau(Int((UBound(Tableau) * Rnd)))) = "x"
 
    Erase Tableau
    i = 0
 
    For Each Cell In Range("B2:K11")
        If Cell = "" Then
            i = i + 1
            ReDim Preserve Tableau(i)
            Tableau(i - 1) = Cell.Address
        End If
    Next Cell
 
DoEvents
Next j
 
End Sub

bonne soiree
michel

[Trooper2]

Merci Michel. Je teste et je te donne des nouvelles.

[Trooper2]

Ca y est, c'est fait. J'ai testé et ca marche parfaitement.

Merci des renseignements. Je vais m'atteller à comprendre.

Parfait