INVERSION DE MATRICES

option base 1

Private Sub MsgErrBox(ByVal Message As String)
    MsgBox Message, vbCritical, "Inversion de matrices"
    End
End Sub

Private Function InverseMatrice(ByRef Matrice() As Double) As Double()
Dim i As Integer, j As Integer, k As Integer
Dim n As Integer
Dim M() As Double, MInv() As Double
Dim Temp As Double

    n = UBound(Matrice, 1)
    
    ' vérifie que la matrice est une matrice carrée
    If UBound(Matrice, 2) <> n Then MsgErrBox "La matrice n'est pas carrée !"
    
    ' crée la matrice n x 2n, composée par M et la matrice identité
    ReDim M(n, 2 * n)
    For i = 1 To n
        For j = 1 To n
            M(i, j) = Matrice(i, j)
            M(i, j + n) = 1 - Sgn(Abs(i - j))
        Next
    Next
    
    ' échelonne la matrice M()
    For i = 1 To n
        ' trouve le pivot (1er élément <> 0)
        j = i
        While M(j, i) = 0
            j = j + 1
            If j > n Then MsgErrBox "La matrice n'est pas inversible !"
        Wend
        ' échange les 2 lignes si elles sont différentes
        ' commence à partir de l'élément i, car tous les précédents sont nuls
        If i <> j Then
            For k = i To 2 * n
                Temp = M(i, k)
                M(i, k) = M(j, k)
                M(j, k) = Temp
            Next
        End If
        ' le pivot devient égal à 1
        If M(i, i) <> 1 Then
            Temp = M(i, i)
            For j = i To 2 * n
                M(i, j) = M(i, j) / Temp
            Next
        End If
        ' sous le pivot, tous les éléments deviennent nuls
        For j = i + 1 To n
            If M(j, i) <> 0 Then
                Temp = M(j, i)
                For k = i To 2 * n
                    M(j, k) = M(j, k) - M(i, k) * Temp
                Next
            End If
        Next
    Next
    
    ' réduit la matrice M()
    For i = n To 2 Step -1
        For j = 1 To i - 1
            If M(j, i) <> 0 Then
                Temp = M(j, i)
                For k = i To 2 * n
                    M(j, k) = M(j, k) - M(i, k) * Temp
                Next
            End If
        Next
    Next
        
    ' retourne le résultat : la deuxième partie de la matrice M()
    ReDim MInv(n, n)
    For i = 1 To n
        For j = 1 To n
            MInv(i, j) = M(i, j + n)
        Next
    Next
    InverseMatrice = MInv
    
End Function