VBA : Esope reste ici et se repose



Poursuivons notre tour d'horizon des classiques incontournables de l'algorithmie. Un moment décisif dans l'étude est celui ou l'on aborde la question des tableaux, entrainant automatiquement des questions de typage, dimensionnement, tri, et autres interrogations...

Il vous sera alors impossible d'échapper au probléme dit du "palindrome", comme vous le savez, il s'agit d'une expression lisible indifféremment de gauche à droite ou de  droite à gauche, conformément au titre de cet article.

Le code suivant vérifiera si le contenu de la cellule A1 contient  ou non un "palindrome", mais il ne sera pas utile de manipuler des tableaux de variables puisqu'il existe une fonction VBA nommée StrReverse() qui inverse automatiquement le contenu d'une chaîne de caractères en langage VBA.


Sub palindrome()
Dim chaine As String
Dim chaine2 As String
chaine = Trim(Application.Substitute(Range("a1").Value, " ", ""))
'==> Trim() La chaine est nettoyé des espaces placés éventuellement devant ou derriére l'expression
'==> application.substitute()
'Les espaces entre les mots sont supprimés quand vous ignorez une fonction VBA, utilisez
'la fonction excel qui devient alors une méthode de l'objet application

chaine2 = StrReverse(chaine)
'il ne reste plus alors que la comparaison
If chaine = chaine2 Then
    MsgBox "La chaine contenu en a1" _
    & Chr(10) & "est un palindrome" _
    , vbOKOnly + vbCritical, "palindrome"
Else
    MsgBox "La chaine contenu en a1" _
    & Chr(10) & "n'est pas un palindrome" _
    , vbOKOnly + vbCritical, "palindrome"
End If
End Sub

A la semaine prochaine...




VBA : La suite de Fibonacci



Poursuivons sur le thème de la semaine dernière, à savoir l'utilisation des fonctions récursives en VBA. Un autre exemple incontournable en algorithmie se trouve dans la suite de Fibonacci, un mathématicien italien du 13éme siècle.
Il s'agit d'une suite d'entier dans laquelle chaque terme est le somme des deux termes qui le précédent. Si on démarre la suite en posant F(0) = 0 et F(1)  = 1, le reste de la suite s'écrira : 

F(n) = F(n-1) + F(n-2)

De quoi écrire une belle fonction récursive de type :


fonction fibo(n)
si (n ≤ 1)
  retourner n 
sinon 
  retourner fibo(n - 1) + fibo(n - 2)
fin de la fonction
 
Voici sa traduction en VBA, ici on saisira un nombre entier dans la cellule F1 de la feuille de
calcul, et Excel, enrichie de cette nouvelle fonction retournera le résultat en  E7.
 
Function fibonacci(ByVal n As Integer) As Long
If n <= 0 Then
'definition de F(0) et F(1)
    fibonacci = 0
    Else
        If n = 1 Then
            fibonacci = 1
        Else
        'recurence à partir du rang 2
            fibonacci = fibonacci(n - 1) + fibonacci(n - 2)
        End If
    End If
End Function
 
Toutefois la récursivité ne s’avère pas toujours, la méthode de calcul la plus rapide, 
aussi voici un algorithme plus linéaire dans l’hypothèse de la manipulation de grand nombres.

Sub Debut()
    Dim x As Byte
    x = InputBox("entrez un entier n = ", "", 0)
    fibonacci x
End Sub
'***************************************
Function fibo(ByVal n As Byte) As Integer
Dim f1 As Integer
Dim f2 As Integer
Dim i As Byte
    Select Case n
        Case 0
            fibo = 0
        Case 1, 2
            fibo = 1
        Case Else
            f1 = 1
            f2 = 1
            For i = 3 To n
                fibo = f2 + f1
                f2 = f1
                f1 = fibo
            Next i
   End Select
   MsgBox "F " & n & " = " & fibo, vbOKOnly + vbCritical, "Fibonacci"
End Function
 
 
 




VBA : Calcul d'une factorielle




Poursuivons notre tour d'horizon des grands classiques proposés lors de l'apprentissage de la programmation informatique. L'appel de fonctions (et) ou de procédures est évidement un sujet particulièrement important puisqu'il touche à l'architecture même des programmes. Rapidement on en vient à parler des fonctions récursives, souvent la bête noire des apprentis programmeurs.

En informatique, une fonction est dite récursive si le calcul nécessite d'invoquer la fonction elle même.

Récursivité donc incontournable pour assurer le calcul de la factorielle d'un entier naturel n.

La factorielle de n (notée n!) est le produit des nombres entiers strictement positif inférieur ou égaux à n.

Exemple 4!  =  4 *  3 * 2 * 1  - Nous posons bien sur 0! = 1 -

Peut on résoudre ce probléme en VBA par un appel récursif  de type ?

  Fonction factorielle (n)
     Si n > 1
        Renvoyer n * factorielle(n - 1)
     Sinon
        Renvoyer 1
     Fin si
  Fin fonction

 Voici  un code très simple permettant de répondre par l'affirmatif, attention toutefois à la croissance exponentielle de l'algorithme. 

Option Explicit
'****************************
Function Factorielle(ByVal x As Integer) As Long
    'ne pas oublier le type de données de la fonction
   If x = 0 Then
      Factorielle = 1
   Else
      Factorielle = Factorielle(x - 1) * x
      ' et voici l'appel récursif
   End If
End Function
'**************************************
 Sub depart2()
   Dim n As Integer
   Dim resultat As Long
   n = InputBox("Entrez un entier n = ", "Factorielle", 0)
   Range("d1").Value = n
   resultat = Factorielle(n) 'appel de la fonction
   'et récupération du résultat

   Range("e1").Value = resultat
End Sub


Bien sur Excel intègre déjà une fonction = FACT( ), mais vous en conviendrez ce n'est pas le même plaisir....
A la semaine prochaine...



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



top