XL 2010 Excel VBA

Konte94 · 21 Février 2020

Salut tout le monde, svp qui peut m'aider à écrire un programme vba qui me permettra d'obtenir un carré magique d'ordre impair avec l'algorithmique de Bachet:

Indication : le nombre 1 doit se placer tout juste en dessous de la cellule centrale.
A chaque fois on descend d'une cellule puis on décale d'une à droite et on met le chiffre consécutif, si on trouve un chiffre là-bas on remonte et on descend de deux cellules et on met le chiffre consécutif ainsi de suite

Exemple
4 9 2
3 5 7
8 1 6

La Somme des lignes, des colonnes et des diagonales est égale.

Dranreb · 22 Février 2020

Pas avant d'avoir défini les noms "LeCarréMagique" et "Coté" à l'aides des commandes Excel faites pour ça et montrées dans l'image poste précédent.

Konte94 · 22 Février 2020

Dranreb à dit:
Pas avant d'avoir défini les noms "LeCarréMagique" et "Coté" à l'aides des commandes Excel faites pour ça et montrées dans l'image poste précédent.

Je dois aller dans formule renommer la fonction ensuite exécuter ?

Dranreb · 22 Février 2020

Ce n'est pas la fonction qu'il faut renommer ce sont les plages sur lesquelles elle doit s'appyuer qu'il faut définir par ces noms. "Coté" pour la cellule qui contiendra le nombre de valeurs souhaitées par coté et "LeCarréMagique" pour la plage qui devra recueillir le résultat.

Konte94 · 22 Février 2020

Sa ne peut pas se faire dans le programme ?

Dranreb · 22 Février 2020

Bien sûr qu'on pourrait figer les emplacements dans la macro mais comme vous n'avez jamais dit où vous voulez tout ça ni jamais joint de classeur pour qu'on puisse le voir …
Le nom "LeCarréMagique" sera toutefois crée par la macro elle même quand même.

Konte94 · 22 Février 2020

Dranreb à dit:
Bien sûr qu'on pourrait figer les emplacements dans la macro mais comme vous n'avez jamais dit où vous voulez tout ça ni jamais joint de classeur pour qu'on puisse le voir …
Le nom "LeCarréMagique" sera toutefois crée par la macro elle même quand même.

Si c'était possible d'utiliser les InputBox. Si on exécute sa nous demande automatiquement la taille souhaité. Je pense que ce sera mieux.

Dranreb · 22 Février 2020

Ça ne dit toujours pas où vous voulez le résultat.

Konte94 · 22 Février 2020

Dranreb à dit:
Ça ne dit toujours pas où vous voulez le résultat.

Je veux que tt soit dans le programme, si j'exécute sa me demande la taille, je le met et automatiquement sa me donne le carré magique

Dranreb · 22 Février 2020

Oui mais ça vous le donne où ?
Vous ne le voulez pas dans des cellules ?
Remarque: on pourrait le mettre à partir de la cellule sélectionnée si vous voulez …

Konte94 · 22 Février 2020

Bien sûr mais je préfère quand tout est figé dans le programme

Dranreb · 22 Février 2020

On le produit à partir de la cellule sélectionnée, alors ? Sinon dites moi l'adresse de la cellule où vous le voulez.

Konte94 · 22 Février 2020

Dranreb à dit:
On le produit à partir de la cellule sélectionnée, alors ? Sinon dites moi l'adresse de la cellule où vous pren

Dranreb à dit:

On le produit à partir de la cellule sélectionnée, alors ? Sinon dites moi l'adresse de la cellule où vous le voulez.

Cliquez pour agrandir...

Choisissez une cellule

Dranreb · 22 Février 2020

VB:

Option Explicit
Sub ProduireCarréMagique()
   Dim Coté As Long, RngCM As Range
   On Error Resume Next
   Coté = InputBox("Combien de nombres par coté ?")
   If Err Then Exit Sub
   Set RngCM = ActiveSheet.[LeCarréMagique]
   If Err Then Set RngCM = Selection
   On Error GoTo 0
   RngCM.ClearContents
   Set RngCM = RngCM.Resize(Coté, Coté)
   RngCM.Value = CarréMagique(Coté)
   RngCM.Worksheet.Names.Add "LeCarréMagique", RngCM
   End Sub
Function CarréMagique(ByVal Coté As Long) As Variant()
   CalculCarréMagique CarréMagique, Coté
   End Function
Sub CalculCarréMagique(T(), ByVal Coté As Long)
   Dim M As Long, Y As Long, X As Long, L As Long, C As Long, N As Long
   ReDim T(1 To Coté, 1 To Coté)
   M = Coté \ 2
   For Y = -M To M: For X = -M To M
      N = N + 1
      L = X + Y + M + Coté
      C = X - Y + M + Coté
      T(L Mod Coté + 1, C Mod Coté + 1) = N
      Next X, Y
   End Sub

Konte94 · 22 Février 2020

Dranreb à dit:

VB:

Option Explicit
Sub ProduireCarréMagique()
   Dim Coté As Long, RngCM As Range
   On Error Resume Next
   Coté = InputBox("Combien de nombres par coté ?")
   If Err Then Exit Sub
   Set RngCM = ActiveSheet.[LeCarréMagique]
   If Err Then Set RngCM = Selection
   On Error GoTo 0
   RngCM.ClearContents
   Set RngCM = RngCM.Resize(Coté, Coté)
   RngCM.Value = CarréMagique(Coté)
   RngCM.Worksheet.Names.Add "LeCarréMagique", RngCM
   End Sub
Function CarréMagique(ByVal Coté As Long) As Variant()
   CalculCarréMagique CarréMagique, Coté
   End Function
Sub CalculCarréMagique(T(), ByVal Coté As Long)
   Dim M As Long, Y As Long, X As Long, L As Long, C As Long, N As Long
   ReDim T(1 To Coté, 1 To Coté)
   M = Coté \ 2
   For Y = -M To M: For X = -M To M
      N = N + 1
      L = X + Y + M + Coté
      C = X - Y + M + Coté
      T(L Mod Coté + 1, C Mod Coté + 1) = N
      Next X, Y
   End Sub

Je parle de sa mais le côté doit être Supérieur à 2 et impair. Je veux si c'est pair que sa n'affiche rien

Dranreb · 22 Février 2020

Mettez If Coté Mod 2 = 0 Then Exit Sub derrière RngCM.ClearContents

XL 2010 Excel VBA

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Konte94

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Discussions similaires