Excel et les maths

Sur cette page :

  • Géométrie, algèbre linéaire
    • Calculer un produit scalaire
    • Calculer la distance entre deux points
    • Calculer les coefficients d'un polynôme de régression
  • Arithmétique
    • Déterminer si un nombre est premier
    • Décomposer un nombre en produit de facteurs premiers
  • Fonctions
    • Calculer une moyenne pondérée
    • Approximation d'une intégrale (méthode de Simpson)
    • Approximation des zéros d'une expression (dichotomie)
  • Algorithmique
    • Calculer les anagrammes d'un mot

Géométrie, algèbre linéaire

Calculer un produit scalaire

Function ProdSca(u As Range, v As Range) As Double

    'Calcul du produit scalaire de u par v
    'u: Composantes de u sur une ligne ou une colonne,
    'v: Composantes de v sur une ligne ou une colonne.
    Dim i As Integer
    Dim nc As Integer

    Dim ps As Double
    nc = u.Cells.Count
    For i = 1 To nc
        ps = ps + u(i) * v(i)
    Next i
    ProdSca = ps

End Function

Calculer la distance entre deux points

Function Distance(P As Range, Q As Range) As Double

    'Calcul de la distance entre deux points du plan ou de l'espace
    'P: coordonnées d'un point entrées sur une ligne ou une colonne,
    'Q: coordonnées d'un autre point entrées sur une ligne ou une colonne.
    Dim d As Double
    Dim Nc As Integer
    Dim Sc As Integer

    Nc = P.Cells.Count
    For i = 1 To Nc
        Sc = Sc + (P(i) - Q(i)) ^ 2
    Next i
    Distance = Sqr(Sc)
End Function

Calculer les coefficients d'un polynôme de régression

Il est possible d'ajouter à un graphique une courbe de tendance polynomiale (par la méthode des moindres carrés). Pour utiliser ce polynôme dans une feuille de calcul, il faut calculer les coefficients de celui-ci par une formule. Si le degré du polynôme est fixé, il est possible de passer par la formule DROITEREG. Mais si le degré est quelconque, il est nécessaire de passer par une fonction VBA.

Syntaxe

{=MoindresCarres(rgX;rgY;p)}

rgX : Plage des valeurs en abscisse
rgY : Plage des valeurs en ordonnée
p : Degré du polynôme de régression

La fonction renvoie la matrice {a0;a1;...;ap} de p+1 lignes des coefficients du polynôme P(x) = a0 + a1*x + ... + ap*x^p calculé.

Code de la fonction

Function MoindresCarres(rgX As Range, rgY As Range, p As Integer)
    Dim n As Integer
    Dim i As Integer
    Dim j As Integer
    Dim M() As Double
    
    n = rgX.Cells.Count
    ReDim M(n - 1, p)
    
    For i = 0 To n - 1
        For j = 0 To p
            M(i, j) = rgX(i + 1) ^ j
        Next
    Next
     With WorksheetFunction
        If rgX.Rows.Count = 1 Then
            MoindresCarres = .MMult(.MInverse(.MMult(.Transpose(M), M)), .MMult(.Transpose(M), .Transpose(rgY)))
        Else
            MoindresCarres = .MMult(.MInverse(.MMult(.Transpose(M), M)), .MMult(.Transpose(M), rgY))
        End If
    End With
    End Function

Arithmétique

Déterminer si un nombre est premier

Function EstPremier(n As Long) As Boolean
    'Renvoie VRAI si n est premier, FAUX sinon.
    Dim i As Integer
    Select Case n
        Case 1
            EstPremier = False
        Case 2
            EstPremier = True
        Case Else
            For i = 2 To n ^ 0.5
                If n / i = Int(n / i) Then
                    EstPremier = False
                    Exit Function
                End If
            Next
            EstPremier = True
    End Select
End Function

Décomposer un nombre en produit de facteurs premiers

Function DecompositionFacteursPremiers(n As Long) As String
    'Décompose un nommbre entier en produit de facteurs premiers
    'et renvoie le résultat sous la forme d'une chaine de caractères
    'du type "2^3*5^2*7^1".
    Dim p As Long
    Dim e As Integer
    Dim str As String

    p = 2
    If n = 1 Then
        DecompositionFacteursPremiers = "Ø"
    Else
        While n <> 1
            If Int(n / p) = n / p Then
                n = n / p
                e = e + 1
            Else
                If e <> 0 Then str = str & p & "^" & e & "*"
                p = p + 1
                e = 0
            End If
        Wend
        DecompositionFacteursPremiers = str & p & "^" & e
    End If
End Function

Fonctions

Calculer une moyenne pondérée

Une fonction très utile pour les profs qui affectent des coéfficients à différentes matières.

Function moyp(r As Range, p As Range) As Double

    'Calcul d'une moyenne pondérée.
    'r: tableau des résultats sur une ligne ou une colonne,
    'p: tableau des poids sur une ligne ou une colonne.
    Dim i As Integer
    Dim nr As Integer
    Dim num As Double
    Dim denom As Double

    nr = r.Cells.Count
    For i = 1 To nr
        num = num + r(i) * p(i)
        denom = denom + p(i)
    Next i
    moyp = num / denom
End Function

Approximation d'une intégrale (méthode de Simpson)

La fonction suivante calcule l'intégrale de la fonction f entre a et b par la méthode de Simpson (approximation de f par un polynôme de degré 2).

Syntaxe

=IntegraleSimpson(f;a;b;n)

f : Expression de la fonction de la variable x (sous forme de texte). Exemple : "SIN(x)".
a : Borne inférieure de l'intervalle.
b : Borne supérieure de l'intervalle.
n : Nombre de subdivisions de l'intervalle. Valeur conseillée : 100.

Code de la fonction

Function IntegraleSimpson(f As String, a As Double, b As Double, n As Integer) As Double
    Dim h As Double
    Dim k As Integer
    Dim ak0 As Double, ak1 As Double
    Dim i As Double
    Dim f0 As Double, f1 As Double, f2 As Double

    h = (b - a) / n
    ak0 = a
    f0 = Evaluate("+" & Replace(Replace(f, "x", a), ",", "."))
    For k = 1 To n
        ak1 = a + k * h
        f1 = Evaluate("+" & Replace(Replace(f, "x", Replace(ak0 + h / 2, ",", ".")), ",", "."))
        f2 = Evaluate("+" & Replace(Replace(f, "x", Replace(ak1, ",", ".")), ",", "."))
        i = i + f0 + 4 * f1 + f2
        f0 = f2
        ak0 = ak1
    Next
    IntegraleSimpson = i * h / 6
    End Function

Approximation des zéros d'une expression (dichotomie)

La fonction suivante permet d'évaluer les valeurs de x pour lesquelles une fonction f continue s'annule.

Syntaxe

=Dichotomie(expr;a;b;Precision)

expr : expression f(x). Par exemple : "LN(x)-1" ou "1+x^2". Les noms des fonctions doivent être inscrits en majuscules (sinon, la fonction ne marche pas si un des noms de fonctions contient un "x").
a, b : encadrement de la racine cherchée. a et b doivent être choisis de façon à ce que la fonction ne s'annule qu'une fois sur l'intervalle [a, b] et que f(a) et f(b) soient de signes contraires.
Precision : précision voulue pour la valeur de la racine (exemple : 0,0001).

La fonction renvoie une valeur approchée avec la précision Precision de la solution de l'équation f(x) = 0 sur l'intervalle [a, b].

Code de la fonction

Function Dichotomie(expr As String, a As Double, b As Double, Precision As Double)
    Dim e As Integer
    Dim r0 As Double, r1 As Double
    If f(expr, b) > f(expr, a) Then
        e = 1
    Else
        e = -1
    End If
    r0 = a
    r1 = b
    While Abs(r1 - r0) > Precision
        If e * f(expr, (r0 + r1) / 2) > 0 Then
            r1 = (r0 + r1) / 2
        Else
            r0 = (r0 + r1) / 2
        End If
    Wend
    Dichotomie = r0
End Function

Function f(expr, x)
    f = Evaluate(Replace(Replace(expr, "x", "(" & x & ")"), ",", "."))
End Function

Algorithmique

Calculer les anagrammes d'un mot

Exécuter la procédure Anagramme inscrit en colonne A toutes les anagrammes du mot de base spécifié. Ainsi, "abc" va donner "abc", "acb", "bac", "bca", "cab" et "cba". Pour un mot de n lettres différentes, il y a n! anagrammes. Si le mot de base contient des lettres identiques, il y aura des doublons dans la colonne A.

Sub Anagramme()
    Dim s As String
    s = InputBox("Mot de base ?" & vbCrLf & "(Maximum 8 caractères.)", "Anagramme", "excel")
    Cells.Clear
    Permutation s, 0, 0
End Sub

Sub Permutation(s As String, c As Integer, ByRef l As Integer)
    Dim i As Integer   
    For i = 1 To Len(s) - c    
        s = Left(s, c) & PermutCirc(Right(s, Len(s) - c))        
        If c = Len(s) - 1 Then
            l = l + 1
            Cells(l, 1).Value = s
        Else
            Permutation s, c + 1, l
        End If        
    Next    
End Sub

Function PermutCirc(s)   
    PermutCirc = Right(s, Len(s) - 1) & Left(s, 1)
End Function

Mot clef associé à cette page :