VBA : La conjecture de Syracuse

Comment reprendre l'activité sur le blog, fortement délaissé ces derniers mois.  Une idée pour aider mes lecteurs à la manipulation du VBA, est de reprendre tous les grands classiques que l'on peut rencontrer dans l'enseignement de l'algorithmie. Aussi je commence cette semaine avec l'indécidable (au sens mathématique du terme) conjecture de Syracuse.

Également appelé suite de Collatz, du nom du mathématicien allemand qui l’énonça  pour la première fois en 1928. Puis, elle apparu à nouveau à l'université de Syracuse (New-York) dans les années 50. Aucune solution n'étant trouvée, le probléme s'est propagé aux autres universités américaines. Dans le contexte de la guerre froide, on évoqua une manœuvre russe pour paralyser la recherche américaine.

Considérons un entier n positif auquel on va faire subir une transformation.

• Si n est pair on le divise par deux
• Si n est impair, on le multiplie par 3 et on ajoute 1

Puis, on recommence sur le résultat obtenu.
Par exemple, en prenant n = 10, on obtient : 10 - 5 -16 - 8 - 4 - 2 - 1

Conjecture :  Quel que soit l'entier n choisit, on finit toujours par atteindre la valeur 1.

Dans cette procédure VBA, nous testons la conjecture pour un entier n compris entre 1 et 100 (l'intervalle [1, 100] est vérifié et on ne peut faire que trois saisies). Ensuite elle calcule le temps de vol ( nombre d'entier rencontré avant de trouver 1 ) et l'altitude maximale ( la valeur maximale de la suite ).

Bonne programmation...

Sub Syracuse()
Dim n As Long
Dim vol As Long
Dim am As Long
Dim cpt As Byte
vol = 0
cpt = 1
n = 0
am = 0
On Error GoTo Sierreur
'******************************
'nettoyage des afichages précédents
Range("d1:d3").ClearContents
Range("a:a").ClearContents
'********************
n = InputBox("Saisir un entier n = ", _
"Conjecture de Syracuse - " & cpt & " fois", 1)
Do While n < 1 Or n > 100
    cpt = cpt + 1
    n = InputBox("Saisir un entier n = ", _
    "Conjecture de Syracuse - " & cpt & " fois", 1)
    If cpt = 3 And ((n < 1) Or (n > 100)) Then
        MsgBox "vous avez essayé 3 fois", _
        vbOKOnly + vbCritical, "Conjecture de Syracuse"
        Exit Sub
    End If
Loop
Range("d3").Value = n
'*****************************
Do While n <> 1
    If n Mod 2 = 0 Then
    'rien de mieux que le modulo pour savoir si un
    'nombre est pair ou impair
        n = n / 2
    Else
        n = (n * 3) + 1
    End If
    vol = vol + 1
    'incrementons le temps de vol
    Cells(vol, 1).Value = n
    If n > am Then
    'recuperons le max
        am = n
    End If
Loop
    Range("d1").Value = vol
    Range("d2").Value = am
Sierreur:
End Sub

Partager |

VBA : Ecrire les couleurs

Comment attribuer des couleurs aux différents objets ? Police, trame de fond des cellules, éléments des graphiques… Il existe plusieurs méthodes d’attribution des couleurs en VBA. Aujourd’hui je vous présente 2 possibilités très simple :

• La première repose sur l’application d’un simple numéro d’index désignant une couleur : 3 pour le rouge, 4 pour le vert,… Dans cette méthode Excel attribue à une propriété ColorIndex( ) 57 couleurs, indexées de 0 à 56. L’index 0 correspond en fait à l’absence de couleurs pour une trame ou à la couleur noire par défaut pour une police.

Cette boucle permet de créer la liste des ColorIndex, couleur et index.

 

Sub Liste_Index_Couleurs()

    Dim nbCouleur As Integer

    Range("a1").Select

    For nbCouleur = 0 To 56 Step 1

        Cells(nbCouleur + 1, 1).Select

        Selection.Font.ColorIndex = nbCouleur

        Cells(nbCouleur + 1, 2).Select

        Selection.Value = nbCouleur

        With Selection

            .HorizontalAlignment = xlCenter

            .Font.Bold = True

        End With

    Next nbCouleur

End Sub

• La seconde méthode consiste à attribuer la couleur grâce à une fonction RGB( ) qui envoie la quantité souhaité de rouge, de vert et de bleu à une propriété Color( ) conformément au célèbre modèle RVB en utilisant une notation décimale sur une échelle allant de 0 à 255.

Cette boucle permet d’affecter 4 096 couleurs (parmi 256³ = 16 777 216 possibilités) avec leurs valeurs en décimales à la propriété Color( )

 

Sub RGB_Color()

Dim rouge As Integer

Dim vert As Integer

Dim Bleu As Integer

Dim lig As Long

lig = 1

For rouge = 0 To 255 Step 16

‘256 / 16 = 16 – 16 * 16 * 16 =4 096

    For vert = 0 To 255 Step 16

        For Bleu = 0 To 255 Step 16

            Cells(lig, 1).Select

            With Selection

                .Interior.Color = RGB(rouge, vert, Bleu)

            End With

            Cells(lig, 2).Value = rouge & "-" & vert & "-" & Bleu

            lig = lig + 1

        Next Bleu

    Next vert

Next rouge

End Sub

Sachez qu’il existe d’autres méthodes pour écrire des couleurs, comme la possibilité d’exprimer les valeurs du  mode RVB en hexadécimale ou d’utiliser un « entier long » pour coder les couleurs…alors peut-être un jour, un autre article sur ce sujet.

Partager |

VBA : La boucle Répéter...jusqu'à

Un bon moyen de gérer la répétition des actions est la boucle répéter...jusqu'à. A l'instar de la boucle Tant que elle va vous permettre de reproduire une ou plusieurs actions, mais avec la garantie que ces actions vont s'effectuer au moins une fois.

Bonne lecture...

Partager |

VBA : La boucle tant que en vidéo

La boucle tant que est une méthode de gestion pour la répétition des actions.

Nous utilisons cette structure lorsque le nombre de répétitions n'est pas déterminé à l'avance.

Vous pouvez rapprocher cette vidéo d'un article paru en Janvier 2010 et intitulé : VBA : La boucle TANT QUE.

Bon visionnage...

Partager |

VBA : La boucle Pour en vidéo

Nous allons démarrer une série de vidéos sur les structures répétitives en VBA Excel, vous pouvez rapprocher ces vidéos, des articles rédigées en Janvier 2010 notamment l'article intitulée VBA : La boucle pour.

Le sujet de cette vidéo est d'expliquer la syntaxe de l'instruction "FOR". Cette structure est répétitive et permettra à votre boucle de faire un travail autant de fois que l'on souhaite pourvu que le nombre d'itération soit connus au départ.

Partager |

VBA : La boucle TANT QUE

La seconde structure répétitive utilisée en algorithmie est la boucle TANT QUE, vous devez la choisir à chaque fois que le nombre d'itérations vous est inconnu au départ et que vous souhaitez évaluer votre condition en entrant dans la boucle. Sa notation générale pourrait s'écrire comme cela :
TANT QUE Condition FAIRE
    Action(s)
Fin de TANT QUE
Voyons comment utiliser cette structure en langage VBA.

- 1 - Dans ce premier exemple nous demandons à l'utilisateur de saisir un nombre entier qui sera stocké dans un tableau. La saisie s'arrêtera lorsque l'utilisateur répondra N à la question "voulez vous entrez un autre nombre ?" Ainsi on n'ignore au départ le nombre d'entier qui sera saisie (cela dépend de l'utilisateur).

Sub MaBoucle_1()
Dim MonTableau(100) As Integer
Dim reponse  As String
Dim x As Integer
x = 1
Do While reponse <> "N"
    MonTableau(x) = InputBox("Entrez un nombre entier ?", "Bonjour", 0)
    x = x + 1
    reponse = UCase(InputBox("Voulez vous rejouer o/n ?", "Bonjour", "O"))
Loop
End Sub

- 2 - Bien évidement l'une des actions contenue dans la boucle doit être susceptible de modifier la condition d'entrée dans la boucle, ainsi dans ce deuxième exemple (surtout ne le tester pas) nous courons droit au désastre puisque rien ne viendra jamais modifier la valeur de la variable reponse.

Sub MaBoucle_2()
Dim MonTableau(100) As Integer
Dim reponse  As String
Dim x As Integer
x = 1
Do While reponse <> "N"
    MonTableau(x) = InputBox("Entrez un nombre entier ?", " ", 0)
    x = x + 1
Loop
End Sub

- 3 - Il existe une autre syntaxe VBA pour l'écriture de la boucle tant que, dans ce troisième exemple nous allons colorier les cellules de la feuille de calcul à l'aide des 57 valeurs possibles de la propriété Interior.ColorIndex

Sub MaBoucle_3()
Dim nbCouleur As Byte
Dim ligne As Byte
nbCouleur = 0
ligne = 1
While ligne <= 57
    Range("A" & ligne).Select
    Selection.Interior.ColorIndex = nbCouleur
'changeons l'index de couleur et incrémentons la ligne pour espérer sortir de la boucle
    nbCouleur = nbCouleur + 1
    ligne = ligne + 1
Wend
End Sub

Partager |

VBA : La boucle POUR

La première structure répétitive utilisée en algorithmie est la boucle POUR, vous devez la choisir à chaque fois que le nombre d'itérations est connu au départ. Sa notation générale pourrait s'écrire comme cela :

POUR Compteur variant de Min à Max FAIRE

 Action(s)

Fin de POUR

Voyons comment utiliser cette structure en langage VBA.

- 1 - Dans ce premier exemple nous allons effectuer la multiplication par 7 d'un entier x variant de 1 à 10, et écrire le résultat dans la colonne A de notre feuille de calcul grâce à la fonction cells(ligne, colonne) :

Sub Ma_boucle_1()

Dim x As Integer

For x = 1 To 10

Cells(x, 1) = x * 7

Next x

End Sub

L'emploi de la variable x derrière l'instruction Next est facultative. Vous noterez que je n'ai pas initialisé la variable x au préalable, cette initialisation se fait en affectant la valeur 1 en entrée de boucle.

- 2 - Dans ce deuxième exemple nous allons préciser la valeur de l'incrément grâce à l'instruction Step (faute de quoi l'incrément est forcément de 1) :

Sub Ma_boucle_2()

Dim x As Integer

Dim y As Integer

y = 0

For x = 1 To 10 Step 3

y = y + 1

Cells(y, 1) = x * 7

Next

End Sub

La variable y me permet de bien écrire sur la ligne suivante à chaque itération, autrement j'écrirai une ligne sur 3.

- 3 - A l'inverse, il peut également y avoir décrémentation de la variable, faisons la table de 7 à l'envers...

Sub Ma_boucle_3()

Dim x As Integer

Dim y As Integer

y = 1

For x = 10 To 1 Step -1

Cells(y, 1) = x * 7

y = y + 1

Next x

End Sub

Attention, si vous ne précisez pas la valeur de décrément, la boucle ne fonctionnera pas.

- 4 - Pour finir un grand classique : L'imbrication de deux boucles POUR. Ici nous souhaitons créer une table avec tous les multiplicateurs de 1 à 10, nous devons donc imbriquer deux boucles pour gérer les écritures en lignes et en colonnes.

Sub table_multiplication()

Dim x As Integer

Dim y As Integer

Dim col As Integer

Dim lig As Integer

Cells(1, 1).Select

Cells(1, 1) = "*"

With Selection

.Font.Bold = True

.Font.Size = 16

.Font.ColorIndex = 3

.HorizontalAlignment = xlCenter

End With

'Ecrivons les entêtes de colonnes

For y = 1 To 10

Cells(1, y + 1).Select

Cells(1, y + 1) = y

With Selection

.Font.Bold = True

.Font.Size = 16

.Font.ColorIndex = 3

.HorizontalAlignment = xlCenter

End With

Next

'Ecrivons les entêtes de lignes

For x = 1 To 10

Cells(x + 1, 1).Select

Cells(x + 1, 1) = x

With Selection

.Font.Bold = True

.Font.Size = 16

.Font.ColorIndex = 3

.HorizontalAlignment = xlCenter

End With

Next

'nous devons connaitre les coordonnées de départ

Range("B2").Select

lig = Selection.Row

col = Selection.Column

For x = 1 To 10 Step 1

For y = 1 To 10 Step 1

Cells(lig, col) = x * y

col = col + 1

'il faut ramener le curseur en début de ligne

If col = 12 Then

col = 2

End If

Next y

lig = lig + 1

Next x

End Sub 

Partager |