XL 2013 Est t'il possible de réaliser ceci sur excel

Staple1600

XLDnaute Barbatruc
Re

En farfouillant un peu sur la vaste toile, j'ai trouvé cet algorithme (rédigé par Arnaldo Gunzi)
Pour ma part, je me suis contenté de créer le VBA pour la restitution du carré et du coloriage ;)
Par défaut, j'ai mis 4 comme taille
Pour créer un carré de 5x5, mettre 5 dans l'inputBox
etc..
PS: J'ai testé jusqu'à un carré de 50x50
(et Excel n'a pas bronché)
VB:
Sub CréerCarreMagique()
Dim outSquare As Variant, vSize&
vSize = CLng(InputBox("Taille du carré?", "Carré magique en VBA", 4))
Application.ScreenUpdating = False
Cells.Clear
magicsquare vSize, outSquare
Range("B2").Resize(vSize, vSize) = outSquare
[B2].End(xlToRight).Offset(, 1).Resize(vSize) = "=SUM(RC[-" & vSize & "]:RC[-1])"
[B2].End(xlDown).Offset(1).Resize(, vSize) = "=SUM(R[-" & vSize & "]C:R[-1]C)"
With [B2].CurrentRegion
.Borders.LineStyle = 1: .Columns.AutoFit
End With
With [B2].Resize(vSize, vSize)
.Interior.Color = vbBlack: .Font.Color = vbWhite: .Font.Bold = True
.HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
End With
End Sub
VB:
Private Sub magicsquare(ByVal size As Integer, ByRef Square As Variant)
'May-2010 / Aug 2015 by Arnaldo Gunzi
'Receives the size of the square returns the MagicSquare in outSquare
'algorithms from: mathworld.wolfram.com
Dim i&, j&, posX&, posY&, posXtest&, posYtest&, tam2&, m&
Dim aux() As String
Dim aux2() As Integer
If size < 3 Then
    MsgBox "The square must have size >= 3"
    Exit Sub
End If
ReDim Square(1 To size, 1 To size)
If size Mod 2 = 1 Then
    'For odd size magic Squares
    posX = (size + 1) / 2
    posY = 1
    For i = 1 To size ^ 2
        Square(posY, posX) = i
            If posY = 1 Then
                posYtest = size
            Else
                posYtest = posY - 1
            End If
            If posX = 1 Then
                posXtest = size
            Else
                posXtest = posX - 1
            End If
        If Square(posYtest, posXtest) = 0 Then
            posY = posYtest
            posX = posXtest
        Else
            posY = posY + 1
        End If
    Next i
ElseIf size Mod 4 = 0 Then
    'size 4
    For i = 1 To size
        For j = 1 To size
            If i Mod 4 = 1 Or i Mod 4 = 0 Then
                If j Mod 4 = 0 Or j Mod 4 = 1 Then
                    Square(i, j) = size ^ 2 - (size * (i - 1) + j) + 1
                Else
                    Square(i, j) = size * (i - 1) + j
                End If
            Else
                If j Mod 4 = 2 Or j Mod 4 = 3 Then
                    Square(i, j) = size ^ 2 - (size * (i - 1) + j) + 1
                Else
                    Square(i, j) = size * (i - 1) + j
                End If
            End If
        Next j
    Next i
Else
    'Sie 6,LUX method
     m = (size - 2) / 4
     ReDim aux(1 To 2 * m + 1, 1 To 2 * m + 1)
     ReDim aux2(1 To 2 * m + 1, 1 To 2 * m + 1)

     For i = 1 To m + 1
        For j = 1 To 2 * m + 1
            aux(i, j) = "L"
        Next j
     Next i
    
    For j = 1 To 2 * m + 1
        aux(m + 2, j) = "U"
    Next j
   
     For i = m + 3 To 2 * m + 1
        For j = 1 To 2 * m + 1
            aux(i, j) = "X"
        Next j
     Next i
   
    aux(m + 1, m + 1) = "U"
    aux(m + 2, m + 1) = "L"
   
    tam2 = 2 * m + 1
    posX = (tam2 + 1) / 2
    posY = 1
    For i = 1 To tam2 ^ 2
        aux2(posY, posX) = i
        If aux(posY, posX) = "L" Then
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 2) = 4 * (i - 1) + 1
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 1) = 4 * (i - 1) + 2
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 2) = 4 * (i - 1) + 3
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 1) = 4 * (i - 1) + 4
        ElseIf aux(posY, posX) = "U" Then
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 1) = 4 * (i - 1) + 1
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 1) = 4 * (i - 1) + 2
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 2) = 4 * (i - 1) + 3
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 2) = 4 * (i - 1) + 4
        ElseIf aux(posY, posX) = "X" Then
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 1) = 4 * (i - 1) + 1
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 2) = 4 * (i - 1) + 2
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 1) = 4 * (i - 1) + 3
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 2) = 4 * (i - 1) + 4
        End If
            If posY = 1 Then
                posYtest = tam2
            Else
                posYtest = posY - 1
            End If
            If posX = tam2 Then
                posXtest = 1
            Else
                posXtest = posX + 1
            End If
        If aux2(posYtest, posXtest) = 0 Then
            posY = posYtest
            posX = posXtest
        Else
            posY = posY + 1
        End If
    Next i
End If
End Sub
 
Dernière édition:

Guillouche Danielle

XLDnaute Occasionnel
Re

En farfouillant un peu sur la vaste toile, j'ai trouvé cet algorithme (rédigé par Arnaldo Gunzi)
Pour ma part, je me suis contenté de créer le VBA pour la restitution du carré et du coloriage ;)
Par défaut, j'ai mis 4 comme taille
Pour créer un carré de 5x5, mettre 5 dans l'inputBox
etc..
PS: J'ai testé jusqu'à un carré de 50x50
(et Excel n'a pas bronché)
VB:
Sub CréerCarreMagique()
Dim outSquare As Variant, vSize&
vSize = CLng(InputBox("Taille du carré?", "Carré magique en VBA", 4))
Application.ScreenUpdating = False
Cells.Clear
magicsquare vSize, outSquare
Range("B2").Resize(vSize, vSize) = outSquare
[B2].End(xlToRight).Offset(, 1).Resize(vSize) = "=SUM(RC[-" & vSize & "]:RC[-1])"
[B2].End(xlDown).Offset(1).Resize(, vSize) = "=SUM(R[-" & vSize & "]C:R[-1]C)"
With [B2].CurrentRegion
.Borders.LineStyle = 1: .Columns.AutoFit
End With
With [B2].Resize(vSize, vSize)
.Interior.Color = vbBlack: .Font.Color = vbWhite: .Font.Bold = True
.HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
End With
End Sub
VB:
Private Sub magicsquare(ByVal size As Integer, ByRef Square As Variant)
'May-2010 / Aug 2015 by Arnaldo Gunzi
'Receives the size of the square returns the MagicSquare in outSquare
'algorithms from: mathworld.wolfram.com
Dim i&, j&, posX&, posY&, posXtest&, posYtest&, tam2&, m&
Dim aux() As String
Dim aux2() As Integer
If size < 3 Then
    MsgBox "The square must have size >= 3"
    Exit Sub
End If
ReDim Square(1 To size, 1 To size)
If size Mod 2 = 1 Then
    'For odd size magic Squares
    posX = (size + 1) / 2
    posY = 1
    For i = 1 To size ^ 2
        Square(posY, posX) = i
            If posY = 1 Then
                posYtest = size
            Else
                posYtest = posY - 1
            End If
            If posX = 1 Then
                posXtest = size
            Else
                posXtest = posX - 1
            End If
        If Square(posYtest, posXtest) = 0 Then
            posY = posYtest
            posX = posXtest
        Else
            posY = posY + 1
        End If
    Next i
ElseIf size Mod 4 = 0 Then
    'size 4
    For i = 1 To size
        For j = 1 To size
            If i Mod 4 = 1 Or i Mod 4 = 0 Then
                If j Mod 4 = 0 Or j Mod 4 = 1 Then
                    Square(i, j) = size ^ 2 - (size * (i - 1) + j) + 1
                Else
                    Square(i, j) = size * (i - 1) + j
                End If
            Else
                If j Mod 4 = 2 Or j Mod 4 = 3 Then
                    Square(i, j) = size ^ 2 - (size * (i - 1) + j) + 1
                Else
                    Square(i, j) = size * (i - 1) + j
                End If
            End If
        Next j
    Next i
Else
    'Sie 6,LUX method
     m = (size - 2) / 4
     ReDim aux(1 To 2 * m + 1, 1 To 2 * m + 1)
     ReDim aux2(1 To 2 * m + 1, 1 To 2 * m + 1)

     For i = 1 To m + 1
        For j = 1 To 2 * m + 1
            aux(i, j) = "L"
        Next j
     Next i
   
    For j = 1 To 2 * m + 1
        aux(m + 2, j) = "U"
    Next j
  
     For i = m + 3 To 2 * m + 1
        For j = 1 To 2 * m + 1
            aux(i, j) = "X"
        Next j
     Next i
  
    aux(m + 1, m + 1) = "U"
    aux(m + 2, m + 1) = "L"
  
    tam2 = 2 * m + 1
    posX = (tam2 + 1) / 2
    posY = 1
    For i = 1 To tam2 ^ 2
        aux2(posY, posX) = i
        If aux(posY, posX) = "L" Then
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 2) = 4 * (i - 1) + 1
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 1) = 4 * (i - 1) + 2
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 2) = 4 * (i - 1) + 3
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 1) = 4 * (i - 1) + 4
        ElseIf aux(posY, posX) = "U" Then
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 1) = 4 * (i - 1) + 1
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 1) = 4 * (i - 1) + 2
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 2) = 4 * (i - 1) + 3
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 2) = 4 * (i - 1) + 4
        ElseIf aux(posY, posX) = "X" Then
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 1) = 4 * (i - 1) + 1
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 2) = 4 * (i - 1) + 2
            Square(2 * (posY - 1) + 2, 2 * (posX - 1) + 1) = 4 * (i - 1) + 3
            Square(2 * (posY - 1) + 1, 2 * (posX - 1) + 2) = 4 * (i - 1) + 4
        End If
            If posY = 1 Then
                posYtest = tam2
            Else
                posYtest = posY - 1
            End If
            If posX = tam2 Then
                posXtest = 1
            Else
                posXtest = posX + 1
            End If
        If aux2(posYtest, posXtest) = 0 Then
            posY = posYtest
            posX = posXtest
        Else
            posY = posY + 1
        End If
    Next i
End If
End Sub
Bonjour à Tous , Bonjour
Bonsoir le fil,

Peut-être que ceci peut vous intéresser...ou pas
En tout cas, c'est de l'Excel ;)
Bonjour à tout le forum , bonjour Staple1600,

Merci d'avoir répondu à mon post !!!

Je ne sais pas faire , ni ou mettre ce code pourriez vous accepter de le faire

Merci d'avance

Cordialement

Danielle
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil,

Danielle
Ne pas savoir n'est pas un obstacle, mais une invitation...à faire montre de curiosité ;)
En par exemple se rendant sur le 1er moteur de recherche venu
Qui ceci fait, devrait par exemple vous menez ici ;)
Normalement à ce stade, vous devez savoir où doit se mettre le code VBA.

Si ce n'est pas le cas, un dernier indice
Dans Excel, faire ALT+F11
Puis Insertion/Module
Là, dans la carré blanc, copier tout le code VBA de mon précédent message
(donc les deux macros)
Ensuite, appuyez sur la touche F5 puis sélectionner la macro qui s'affiche et cliquez sur Exécuter
Puis de nouveau, sur ALT+F11 pour revenir sur la feuille Excel.

Si tout s'est bien passé, vous devez avoir un carré magique sur la feuille active de votre classeur.
 

Guillouche Danielle

XLDnaute Occasionnel
Bonsoir le fil,

Danielle
Ne pas savoir n'est pas un obstacle, mais une invitation...à faire montre de curiosité ;)
En par exemple se rendant sur le 1er moteur de recherche venu
Qui ceci fait, devrait par exemple vous menez ici ;)
Normalement à ce stade, vous devez savoir où doit se mettre le code VBA.

Si ce n'est pas le cas, un dernier indice
Dans Excel, faire ALT+F11
Puis Insertion/Module
Là, dans la carré blanc, copier tout le code VBA de mon précédent message
(donc les deux macros)
Ensuite, appuyez sur la touche F5 puis sélectionner la macro qui s'affiche et cliquez sur Exécuter
Puis de nouveau, sur ALT+F11 pour revenir sur la feuille Excel.

Si tout s'est bien passé, vous devez avoir un carré magique sur la feuille active de votre classeur.
Bonsoir le forum ,Staple1600

je viens de suivre vos conseils mais rien se passe pas doué et mon ruban Anglais

dur dur , je suis perdu mais merci de la marche à suivre

En attendant pourriez vous le faire

Cordialement

Danielle

Danielle
 

Staple1600

XLDnaute Barbatruc
Re

J'ai tout décrit dans mon précédent message
Que se passe-t-il quand tu fais ALT+F11
(c'est à dire tout en restant appuyé sur la touche ALT, appuyez simultanément sur la touche F11)


NB: J'ai pris le parti de ne plus joindre de fichier Excel
Ce, entre autre, pour inciter le demandeur à mettre les mains dans le cambouis.
Donc toujours partant pour donner explications, détails et conseils, mais "absent" pour joindre du classeur Excel sur le forum ;)
 

Guillouche Danielle

XLDnaute Occasionnel
Re

J'ai tout décrit dans mon précédent message
Que se passe-t-il quand tu fais ALT+F11
(c'est à dire tout en restant appuyé sur la touche ALT, appuyez simultanément sur la touche F11)

Il y à un grand carré blanc et plein d'onglets 9 au total ouvert

Ensuite
Re

J'ai tout décrit dans mon précédent message
Que se passe-t-il quand tu fais ALT+F11
(c'est à dire tout en restant appuyé sur la touche ALT, appuyez simultanément sur la touche F11)


NB: J'ai pris le parti de ne plus joindre de fichier Excel
Ce, entre autre, pour inciter le demandeur à mettre les mains dans le cambouis.
Donc toujours partant pour donner explications, détails et conseils, mais "absent" pour joindre du classeur Excel sur le forum ;)
Lorsque j'ai fais cela un grand carré blanc et des onglets se sont ouvert en bas
 

Staple1600

XLDnaute Barbatruc
Re

Donc aprés avoir fait ALT+F11
Tu vas dans le menu Insertion et tu choisis Module
Normalement à cette étape, à gauche tu voir apparaître Module1
Dans la grande zone blanche, à droite de l'écran, tu copies les deux macros du message#2

Est-ce que jusque là, c'est OK ?
 

Staple1600

XLDnaute Barbatruc
Re

Alors va dans l'onglet DEVELOPER
et là aller dans le menu Insert ou Insertion
et faire ce que j'ai décris précédemment.

NB: Il faudrait peut-être songer à activer ta version d'Office, non...:rolleyes:
 

Staple1600

XLDnaute Barbatruc
Re

Merci d'être attentive à ce j'écris...
Il y a deux macros à copier
La mienne nommée CréerCarreMagique et celle d'Arnaldo Gunzi
Donc normalement, devrait apparaître CréerCarreMagique dans la boite de dialogue de ta précédente copie d'écran.

PS: Pas de commentaires sur le NB de mon précédent message... :rolleyes: ?
 

Staple1600

XLDnaute Barbatruc
Re

Résumé des étapes (au nombre de trois)
Quand le code VBA est bien collé dans un module et que tu appuies sur F5, voici ci-dessous ce qui doit se passer
guillouche.jpg

1) On choisis la macro et on clique sur Exécuter
2) On laisse 4 ou on saisit un autre nombre (pour définir la taille du carré) et on clique sur OK
3) C'est le résultat qui s'affiche sur l'onglet actif
(ici taille du carré 4, qui est la taille par défaut prévu dans le code VBA)
 

Guillouche Danielle

XLDnaute Occasionnel
Re

Résumé des étapes (au nombre de trois)
Quand le code VBA est bien collé dans un module et que tu appuies sur F5, voici ci-dessous ce qui doit se passer
Voir la pièce jointe 1033633

1) On choisis la macro et on clique sur Exécuter
2) On laisse 4 ou on saisit un autre nombre (pour définir la taille du carré) et on clique sur OK
3) C'est le résultat qui s'affiche sur l'onglet actif
(ici taille du carré 4, qui est la taille par défaut prévu dans le code VBA)
Bonjour le Forum et Staple1600,

J'ai réussi pas sans mal en faites je n'avais pas vu que le carré était déjà réalisé

Merci pour ce cours c'est intéressant de faire ,il faut que je change mon excel

pourtant j'ai mis Français mais l'écriture reste Anglais et il faut que je passe la souris dessus

Merci merci

Cordialement

Danielle
 

Guillouche Danielle

XLDnaute Occasionnel
Re

Résumé des étapes (au nombre de trois)
Quand le code VBA est bien collé dans un module et que tu appuies sur F5, voici ci-dessous ce qui doit se passer
Voir la pièce jointe 1033633

1) On choisis la macro et on clique sur Exécuter
2) On laisse 4 ou on saisit un autre nombre (pour définir la taille du carré) et on clique sur OK
3) C'est le résultat qui s'affiche sur l'onglet actif
(ici taille du carré 4, qui est la taille par défaut prévu dans le code VBA)
Quel est la formule à utiliser pour faire une recherche exemple dans le carré

en partant exemple du chiffre 2 ET 3 en partant vers le bas et vers la droite si possible

et faire le classement donc 2 11 7 14 3 10 6 15 en automatique

En attente de vous relire Merci d'avance

cordialement

Danielle
 

Victor21

XLDnaute Barbatruc
Supporter XLD
Bonjour, Guillouche Danielle

Quel est la formule à utiliser pour faire une recherche exemple dans le carré
en partant exemple du chiffre 2 ET 3 en partant vers le bas et vers la droite si possible
et faire le classement donc 2 11 7 14 3 10 6 15 en automatique[...]
Faire une recherche consiste, à partir d'un existant (où est-il ?) d'appliquer des critères définis (quels sont-ils ?) afin d'obtenir un résultat (Lequel ?)
Faire un classement consiste, à partir d'un existant (où est-il ?) d'appliquer des critères définis (quels sont-ils ?) afin d'obtenir un résultat (Lequel ?)
 

Guillouche Danielle

XLDnaute Occasionnel
Bonjour, Guillouche Danielle


Faire une recherche consiste, à partir d'un existant (où est-il ?) d'appliquer des critères définis (quels sont-ils ?) afin d'obtenir un résultat (Lequel ?)
Faire un classement consiste, à partir d'un existant (où est-il ?) d'appliquer des critères définis (quels sont-ils ?) afin d'obtenir un résultat (Lequel ?)
Bonjour le forum ,Bonjour Victor21

Voir pièce jointe
 

Fichiers joints

Victor21

XLDnaute Barbatruc
Supporter XLD
Re, Guillouche Danielle.

J'ai vu votre pièce jointe, je l'ai ouverte. C'est joli :)
Mais à part "voir pièce jointe" qui s'apparente à "Débrouillez-vous avec ça", je n'ai pas vu -pas compris ?- la moindre explication.

Nous en sommes déjà au 19° échange, et vous n'avez toujours pas obtenu de solution. Peut-être le problème n'est-il pas exposé suffisamment clairement ?
Vous serait-il possible d'exprimer en phrases simples (un sujet, un verbe, un complément) le but de l'opération, en séparant bien, et dans le bon ordre, les différentes actions qui permettent d'arriver au résultat ?
Au départ j'ai ça (1), j'applique telles règles, et j'obtiens ça (2) que je place à tel emplacement
Avec ça (2), j'applique telle règle et j'obtiens ça (3) que je place à tel emplacement.
Avec......
Enfin, avec ça (n) j'applique telle règle pour obtenir le résultat final, soit [.....] que je place à tel emplacement.
C'est certes plus long que "voir pièce jointe", mais je crois nécessaire si vous voulez obtenir une réponse utilisable :)
 

Guillouche Danielle

XLDnaute Occasionnel
Re, Guillouche Danielle.

J'ai vu votre pièce jointe, je l'ai ouverte. C'est joli :)
Mais à part "voir pièce jointe" qui s'apparente à "Débrouillez-vous avec ça", je n'ai pas vu -pas compris ?- la moindre explication.

Nous en sommes déjà au 19° échange, et vous n'avez toujours pas obtenu de solution. Peut-être le problème n'est-il pas exposé suffisamment clairement ?
Vous serait-il possible d'exprimer en phrases simples (un sujet, un verbe, un complément) le but de l'opération, en séparant bien, et dans le bon ordre, les différentes actions qui permettent d'arriver au résultat ?
Au départ j'ai ça (1), j'applique telles règles, et j'obtiens ça (2) que je place à tel emplacement
Avec ça (2), j'applique telle règle et j'obtiens ça (3) que je place à tel emplacement.
Avec......
Enfin, avec ça (n) j'applique telle règle pour obtenir le résultat final, soit [.....] que je place à tel emplacement.
C'est certes plus long que "voir pièce jointe", mais je crois nécessaire si vous voulez obtenir une réponse utilisable :)
Re Bonjour ,

Donc en espérant que je vais vous expliquez correctement

Nous avons un carré formé B2 à E5

Ligne K 4 et L4 dans l'exemple nous avons 3 7
Recherche dans le carré d'abord à partir du premier chiffre le 3 donc en K4
Et ensuite le 2ème qui est ici dans l'exemple en L4 et qui est le 7

En P4 et Q4 à Éliminer le 2 et 15 dans cette exemple

Donc il faut regarder perpendiculairement et horizontalement
à quelle ligne les n° correspondent… exemple ici pour le n°3 (à savoir que les chiffres changeront en fonction du besoin )


3
10
6
15

162313

On classe du plus petit au plus grand et d'abord du chiffre 3
3610

D2 D5
sans le 15 car il fait parti des éliminés

et LIGNE 2 horizontale nous avons donc 3
162313

sans le 2 car il fait parti des éliminés
Résultats recherché et final
Classement sans répétition de chiffre
36101316711912
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas