Calcul de racine carre entieres

Commenter

Contenu du snippet

taper sqr(1234) on vous répond 35

Source / Exemple : 


Function racine(ByVal a As Integer) As Integer
    Dim lenn As Integer
    lenn = lennb(a) + 2
    Dim two As Integer
    Dim nbmoins As Integer
    Dim impaire As Integer
    impaire = 1
    Dim res As Integer
    If lenn Mod 2 = 1 Then
        lenn = lenn - 1
        two = chiffre(a, lenn - 1)
    Else
        lenn = lenn - 2
        two = chiffre(a, lenn) * 10 + chiffre(a, lenn - 1)
    End If
    Do
        nbmoins = 0
        While impaire <= two
            nbmoins = nbmoins + 1
            two = two - impaire
            impaire = impaire + 2
        Wend
        impaire = (impaire - 1) * 10 + 1
        res = res * 10 + nbmoins
        If lenn > 0 Then
            lenn = lenn - 2
            two = two * 100 + chiffre(a, lenn) * 10 + chiffre(a, lenn - 1)
        End If
    Loop While lenn > 0
    racine = res
End Function

Function chiffre(ByVal nb As Integer, ByVal pos As Integer) As Integer
    Dim i As Integer
    For i = 1 To pos - 1
        nb = nb / 10 'on coupe ce qui suit
    Next
    chiffre = nb Mod 10 'on ne prend pas ce qu'in y a avant
End Function

Function lennb(nb As Integer) As Integer
    lennb = Len(CStr(nb))
End Function

Conclusion :


lennb renvoi la taille d'un nombre et chiffre le n-ème chiffre de nb.
la méthode parrait peut-etre fantaisiste mais elle fonctionne très bien!

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_dtom)