Discussion :

[Shuhala]

Bonjour!
Je suis nouvelle sur le forum, également en VBA (j'ai mis pour la première fois mon nez dedans il y a quelques heures), et j'admet être un peu perdue sur la façon de procéder pour arriver au résultat que je veux.
En bref, je fais un jeu sur Excel, et pour celui-ci j'ai besoin de générer aléatoirement 5 chiffres différent 5,4,3,3 et 2 fois dans une plage. J'ai cependant quelques contraintes.

• Les chiffres doivent apparaître côte à côte
• Ils doivent être vertical ou horizontal
• Ils ne doivent pas dépasser une ligne ou colonne (ne doit pas continuer à la suite de la prochaine ligne ou colonne)

J'ai commencé avec comme base un code que j'ai trouvé sur un forum qui permettait de générer aléatoirement des "x" sur une plage (dans mon cas 10x10). J'ai réussi à l'adapter pour qu'il génère plutôt des "1" le nombre de fois que j'avais besoin.
Là par contre pour que ces "1" soient chacun côte à côte horizontalement OU verticalement je ne sais plus trop. J'ai réussi à les coller en ajoutant +1 à i mais ça ne le génère que horizontalement dans ce cas.
De plus, j'ai également le problème que si le nombre aléatoire arrive vers la fin de la ligne de la plage, il continu à la suite de la prochaine, alors que dans mon cas c'est important qu'ils restent groupé.

Comme j'ai dis plus tôt, je n'ai jamais touché au VBA, je sais que mon code est probablement très moche à voir (haha) mais j'y vais beaucoup par essai erreur pour apprendre en ce moment :p.
Si vous pouvez me donner une bonne piste ou une solution à mon problème je vous serais éternellement reconnaissante!

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
 
Sub Test()
    RemplissageAleatoire Range("F9:O18"), 20
End Sub
 
 
Sub RemplissageAleatoire(Plage As Range, Bateau As Integer)
    Dim Tableau As Collection
    Dim Cell As Range
    Dim i As Integer, j As Integer
 
    If Plage.Cells.Count < Bateau Then Exit Sub
 
    'suppression des anciennes données
    Plage.Cells.Clear
 
 
    Set Tableau = New Collection
    For Each Cell In Plage
        Tableau.Add Cell.Address
    Next Cell
 
 
    'For j = 1 To 1
        Randomize
        DoEvents
        i = Int((Tableau.Count * Rnd) - 5)
 
        Range(Tableau(i)) = "1"
        Range(Tableau(i + 1)) = "1"
        Range(Tableau(i + 2)) = "1"
        Range(Tableau(i + 3)) = "1"
        Range(Tableau(i + 4)) = "1"
        Tableau.Remove i
        DoEvents
    'Next j
 
 
End Sub

Merci!

[Theze]

Bonjour,

Regarde si ça te convient et adapte :

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
 
Sub Test()
 
    Aleatoire Range("F9:O9"), 10
 
End Sub
 
Sub Aleatoire(Plage As Range, Nombre As Long)
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Result As Long
    Dim I As Integer
 
    If Plage.Count <> Nombre Then Exit Sub
 
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'Initialise le générateur de nombres aléatoires
    Randomize
 
    Do
        Result = Int((Nombre * Rnd) + 1)
 
        If Dico.exists(Result) = False Then Dico.Add Result, Result
 
    Loop While Dico.Count <> Nombre
 
    For Each Cle In Dico.Keys
 
        I = I + 1
        Plage(1, I) = Cle '<-- soit en ligne...
 
        Plage(I, 1) = Cle '<-- soit en colonne...
 
    Next Cle
 
End Sub

Hervé.

[Shuhala]

Oui et non, mais merci d'avoir tenté .
Je vais joindre un screenshot qui démontre plus visuellement ce que j'essai de faire



J'ai donc besoin que ça puisse générer dans le fond un série de 5 chiffres (5,4,3,3 et 2fois) soit horizontalement ou verticalement aléatoirement dans ma plage.

[Kimy_Ire]

Bonjour Shuhala,

Ton problème m'a fait marrer et voici ce que je te propose :

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
Option Explicit
 
Sub Bat_nav()
Dim i As Integer
Dim grille As Range
Dim nav(1 To 5) As Integer
 
nav(1) = 5
nav(2) = 4
nav(3) = 3
nav(4) = 3
nav(5) = 2
 
With Worksheets("Feuil7")
    Set grille = .Range("B2:K11")
    grille.ClearContents
 
    For i = LBound(nav) To UBound(nav)
        Call placement(nav(i), grille, i)
    Next i
 
End With
 
End Sub
 
Function placement(longueur As Integer, rng As Range, numero As Integer)
Dim i As Integer
Dim place As Integer
Dim hor_ver As Integer
Dim verif As Range
Dim CurCell As Range
Dim Bool As Boolean
 
Do
    Randomize
 
    hor_ver = Int((2 * Rnd) + 1)
    place = Int((rng.Count * Rnd) + 1)
 
    i = 0
    For Each CurCell In rng
        i = i + 1
        If i = place Then
            If hor_ver = 1 Then
                Set verif = Range(CurCell, CurCell.Offset(0, longueur - 1))
 
            ElseIf hor_ver = 2 Then
                Set verif = Range(CurCell, CurCell.Offset(longueur - 1, 0))
            End If
 
            Exit For
        End If
    Next CurCell
 
    Bool = True
    For Each CurCell In verif
        If CurCell <> "" Or Application.Intersect(CurCell, rng) Is Nothing Then
            Bool = False
        End If
    Next CurCell
Loop While Bool = False
 
If Bool Then
    For Each CurCell In verif
        CurCell = numero
    Next CurCell
End If
 
End Function

A adapter à ta place/à ta feuille.

J'ai surement réinventé la roue et mon code n'est pas optimisé, mais je crois qu'il répond à ton besoin !

N'hésite pas à revenir vers moi !

Cordialement,
Kimy

[Shuhala]

Oh wow, c'est génial ça fonctionne !
Je te remercie énormément, je vais donc analyser plus en détail ce que tu as fais afin de comprendre comment l'appliquer à l'avenir.

Thanks!

[Kimy_Ire]

Commenté :

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
Option Explicit
 
Sub Bat_nav()
'Initialisation des variables
Dim i As Integer
Dim grille As Range
Dim nav(1 To 5) As Integer
 
'On défini nos longueurs de bateaux
nav(1) = 5
nav(2) = 4
nav(3) = 3
nav(4) = 3
nav(5) = 2
 
'Avec "Feuil7" - à adapter
With Worksheets("Feuil7")
    'On défini la grille de jeu - (= B2:K11 ici)
    Set grille = .Range("B2:K11")
    'On clear la grille
    grille.ClearContents
 
    'On parcour l'ensemble des bateaux...
    For i = LBound(nav) To UBound(nav)
        '... en appelant la fonction "placement" ci-dessous.
        Call placement(nav(i), grille, i)
    Next i
 
End With
 
End Sub
 
Function placement(longueur As Integer, rng As Range, numero As Integer)
'Initialisation des variables
Dim i As Integer
Dim place As Integer
Dim hor_ver As Integer
Dim verif As Range
Dim CurCell As Range
Dim Bool As Boolean
 
'On rentre dans la boucle
Do
    'On initialise le générateur de nombres aléatoires
    Randomize
 
    'On défini hor_ver de 1 à 2
    hor_ver = Int((2 * Rnd) + 1)
    'On défini la place initiale sur l'ensemble des cellules de la range "rng"
    place = Int((rng.Count * Rnd) + 1)
 
    'On défini i = 0
    i = 0
 
    'On parcours l'ensemble des cellules de "rng" (= B2:K11 ici)
    For Each CurCell In rng
        'On incrémente i
        i = i + 1
 
        'Si i = place => on est sur la cellule définie aléatoirement
        If i = place Then
            'On vérifie si on est horizontal ou vertical (respectivement 1 ou 2)...
            If hor_ver = 1 Then
                '... et on défini la plage correspondante en fonction de la cellule initiale
                Set verif = Range(CurCell, CurCell.Offset(0, longueur - 1))
            ElseIf hor_ver = 2 Then
                Set verif = Range(CurCell, CurCell.Offset(longueur - 1, 0))
            End If
 
            'On sort de la boucle
            Exit For
        End If
    Next CurCell
 
    'On set Bool à True (et on le repasse à False si la plage ne correspond pas aux attentes)
    Bool = True
 
    'Pour chaque cellule de verif...
    For Each CurCell In verif
        '... on vérifie si elle est vide (pas d'autre bateau) et si elle ne sort pas de la range définie (= B2:K11 ici)
        If CurCell <> "" Or Application.Intersect(CurCell, rng) Is Nothing Then
            'Sinon, on repasse Bool à False
            Bool = False
        End If
    Next CurCell
 
'Et on reboucle le tout tant qu'on a pas Bool différent de False
Loop While Bool = False
 
'Si Bool est True (test qu'on peut enlever, la vérification s'étant effectuée avant)...
If Bool Then
    '... alors pour chaque cellule de la range "verif" on place le chiffre du bateau.
    For Each CurCell In verif
        CurCell = numero
    Next CurCell
End If
 
End Function

si pertinent et en bas de page si sujet clôt.

Cordialement,
Kimy

[Marc-L]

Bonjour, bonjour !

En respectant la règle TBTO, moins d'une vingtaine de lignes de code à coller dans le module d'un classeur (ThisWorkbook) …

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
Sub Demo()
    Dim Rg As Range
    With Feuil1.[A1:J10]
        .ClearContents
        For Each C In [{5,4,3,3,2}]
            H% = Rnd Mod 2:  V% = V% + 1
            Do
              Set Rg = .Cells(Fix(Rnd * .Count) + 1).Resize(1 + (C - 1) * (1 - H), 1 + (C - 1) * H)
              If Intersect(.Cells, Rg).Count = C And Application.Sum(Rg) = 0 Then Rg.Value = V: Exit Do
            Loop
        Next
    End With
    Set Rg = Nothing
End Sub
 
Private Sub Workbook_Open()
    Randomize
End Sub

_________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé …

[Kimy_Ire]

Bonjour Marc-L,

C'est évident que moi je ne peux pas écrire ça !
J'y travaille quoi qu'il en soit.

Merci pour la leçon !

Cordialement,
Kimy

[Marc-L]

Bonjour Michael !

C'est juste un rappel de penser objet … En traduisant mon code en langage courant, la logique est vraiment simple !
Avant d'entreprendre un code, visualiser ce qui doit être fait au niveau objet : cela le réduira à l'essentiel …

Une variante laissant de l'espace entre chaque élément : en y changeant l'approche - passage d'une plage fixe
à une plage variable selon la taille de l'élément, l'empêchant ainsi de sortir de la grille - la procédure, allégée
d'un test et se passant d'une variable objet, s'avère encore plus efficace ! Code à coller dans le module du classeur :

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
Sub Demo()
    Const L% = 11
    Application.ScreenUpdating = False:  Feuil1.Cells(1).Resize(L - 1, L - 1).ClearContents
    For Each C In [{5,4,3,3,2}]
        H% = Rnd Mod 2:  V% = V% + 1
        With Feuil1.Cells(1).Resize(L - C, L - C)
            Do
               With .Cells(Fix(Rnd * .Count) + 1).Resize(1 + (C - 1) * (1 - H), 1 + (C - 1) * H)
                    If Application.Sum(.Cells) = 0 Then .Value = V: _
                       If .CurrentRegion.Count = C Then Exit Do Else .ClearContents
               End With
            Loop
        End With
    Next
End Sub
 
Private Sub Workbook_Open()
    Randomize
End Sub

_________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé …