Boucle (d'or) chez un ours

Bonjour tous le monde...

Comme d'habitude quand je bloque c'est la que je sors de ma tanière pour demander de l'aide et ici c'est sur mon ennemi juré, les boucles

J'ai une zone de 3 x 3. Je souhaite appliquer à chaque cellule de la zone une formule... comment je fais, toutes mes tentatives avec for ont échouées.

Une proposition pour tout ceci svp?

Pour info en vrai j'ai 27 zones de 3x3 définies en Range sous cette forme (je simplifie grandement mon soucis pour ne pas vous flood) :

Dim LL1 As Range '[...]
lig = Res.Row
col = Res.Column
Set LL1 = Range(Cells(lig, col), Cells(lig + 2, col + 2))
'[...]

Merciiiiiii

Salut Atro,

Tu devrais t'en sortir comme ça :

For x = 1 to 27
    For each cell in Worksheet("Ta_feuille").Range("X" & x+3 & ":X" & x+6)
        'Ton code
    Next cell
Next x

Il te suffit juste de trouver ta relation entre x et tes zone 3x3 ! (Ici, j'ai mis au pif)

Bonne journée,

Baboutz

Okay Merci ^^. Petite question complémentaire et j'arrête d'embêter (je pense). Qui saurait comment éviter les doublons dans cette zone (c'est des chiffres de 1 à 9 qui sont rentrés. Il y aurait donc que la série 1, 2, 3... jusqu'à 9).

Je n'ai pas compris, je croyais que tu voulais mettre une formule dans la cellule...

Néanmoins pour vérifier, tu peux également utiliser un for each :

For each cell in Worksheet("Ta_feuille").Range("X" & x+3 & ":X" & x+6)
    If Not cell.value = "3" then 'Par exemple 3
        'ton code
    End if
Next cell

Tu peux également utiliser la méthode .find :

Set recherche = Worksheets("Ta_feuille").Range("XX:XX").Find(What:="3", lookat:=xlWhole)

If recherche Is Nothing then
    'ton code
End if

Tu ne m'embêtes pas du tout, il y a aucun soucis !

Baboutz

En fait c'est super tordu comme truc XD

J'ai 3 lignes sur 9 colonnes.

Sur chaque bloc de 3x3 j'applique une formule de génération de nombre aléatoire avec Int((9 - 1 + 1) * Rnd + 1) MAIS dans chaque bloc de 3x3 il ne doit pas y avoir de doublons. il y aura donc que 1, 2, 3, 4, 5, 6, 7, 8, 9 par bloc de 3, l'ordre changera juste en fait

On dirait un début de sudoku ton truc ahah !

Tu peux me montrer un fichier avec les 27 lignes à remplir que j'y réfléchisse ? (A l'endroit où tu veux que ça soit rempli dans ton fichier d'origine)

Ah yes pas con je vais essayer de chercher si il n'y a pas des vba-teurs qui ont créé des générateurs de sudoku tiens

Malheureusement pas de fichier avant demain. J'ai quitté le boulot et mon pc perso à cramé xb

Pour comprendre c'est pour générer des clés de chiffrement en fonction des séquences. Donc c'est de A1 à AA3. Avec les chiffres de 1 à 9 en vrac sur la zone A1 C3. Puis en vrac de 1 à 9 sur D1 F3. Etc. Avec une feuille vierge ça fonctionne pas besoin de fichier en somme

Salut Atro,

Salut Baboutz,

quelque chose comme ça ?

Un double-clic sur la feuille relance chaque fois un nouveau calcul.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tT(1 To 9), rCel As Range
'
Cancel = True
Application.ScreenUpdating = False
'
For x = 1 To 25 Step 3
    For Each rCel In Range(Chr(64 + x) & 1).Resize(3, 3)
        Do
            Randomize
            iClé = WorksheetFunction.RandBetween(1, 9)
        Loop Until tT(iClé) = 0
        rCel.Value = iClé
        tT(iClé) = 1
    Next
    With Range(Chr(64 + x) & 1).Resize(3, 3)
        .Interior.ColorIndex = IIf(x Mod 2 = 0, 15, 16)
        .Borders.LineStyle = xlContinuous
        .BorderAround Weight:=xlThick
    End With
    Erase tT
Next
'
Application.ScreenUpdating = True
'
End Sub

A chacun sa croix, n'est-ce pas : toi, les boucles, moi, le Dico...

A+

6atro.xlsm (14.86 Ko)

Salut Atro,

Salut Baboutz,

quelque chose comme ça ?

Un double-clic sur la feuille relance chaque fois un nouveau calcul.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tT(1 To 9), rCel As Range
'
Cancel = True
Application.ScreenUpdating = False
'
For x = 1 To 25 Step 3
    For Each rCel In Range(Chr(64 + x) & 1).Resize(3, 3)
        Do
            Randomize
            iClé = WorksheetFunction.RandBetween(1, 9)
        Loop Until tT(iClé) = 0
        rCel.Value = iClé
        tT(iClé) = 1
    Next
    With Range(Chr(64 + x) & 1).Resize(3, 3)
        .Interior.ColorIndex = IIf(x Mod 2 = 0, 15, 16)
        .Borders.LineStyle = xlContinuous
        .BorderAround Weight:=xlThick
    End With
    Erase tT
Next
'
Application.ScreenUpdating = True
'
End Sub

A chacun sa croix, n'est-ce pas : toi, les boucles, moi, le Dico...

A+

Bonjour... ça fonctionne du tonnerre mais now j'essaie de comprendre quelques éléments. Désolé mais autant en USF je gère autant ce type de code je suis totalement novice ^^

Juste à confirmer :

Chr(64 + x) => @+x ça donne par défaut rien si x = 0, mais A, B, C etc si 1 ou plus? remplacer par un .Cells ne serait pas plus précis si je veux le mettre ailleurs qu'en A1 par exemple ?

Salut Atro,

  • X ne sera jamais = 0 puisque la boucle va de 1 à 25 !
  • cela donne effectivement A, D, G... à cause du Step 3.
  • ailleurs qu'en [A1] ?? Explique!

A+

- ailleurs qu'en [A1] ?? Explique!

Je n'ai pas besoin que ce soit ailleurs qu'en A1 mais je pense à d'autres outils que je fais, tu intègre une inputbox pour connaitre le lien de lancement de ta macro et paf c'est ailleurs que A1. C'est juste de la curiosité pour apprendre

Exemple :

Dim Res As Range
Set Res = Application.InputBox("Sélectionnez l'adresse de cellule (ex : C3)" & vbLf & "d'où partira le jenesaisquoi." & vbLf & vbLf & "La taille sera de : 3 x 27.", "Saisir une cellule", "B2", Type:=8)
lig = Res.Row
col = Res.Column

For x = 1 To 25 Step 3
    For Each rCel In Cells(lig, col - 1 + x).Resize(3, 3)
        Do
            Randomize
            iClé = WorksheetFunction.RandBetween(1, 9)
        Loop Until tT(iClé) = 0
        rCel.Value = iClé
        tT(iClé) = 1
    Next
    Erase tT
Next

'Reste du code
Exit Sub

Salut Atro,

  • tu double-cliques où tu veux pour une série contigüe horizontale à partir de cette cellule ;
  • tu sélectionnes au moins 2 cellules, ou plus évidemment, pour créer une série avec décalage verticale ou horizontale ou en escalier ;
    iSCol = Selection.Column
    iSRow = Selection.Row
    iWidth = Selection.Columns.Count
    iHeight = Selection.Rows.Count
    Cells.Delete
    '
    For x = 0 To 7
        iRow = IIf(x = 0 Or iHeight = 1, iSRow, iSRow + (x * (3 + iHeight - 1)))
        iCol = IIf(x = 0 Or iWidth = 1, iSCol, iSCol + (x * (3 + iWidth - 1)))

Pour le plaisir du code !

A+

3atro.xlsm (17.11 Ko)

J'aurais appris plein de choses, hors sujet mais intéressantes, merci

Rechercher des sujets similaires à "boucle ours"