Sortie matricielle du fonction VBA

Bonjour à toutes et à tous,

Je reviens vers vous car j'ai un petit soucis.

J'ai une fonction VVPrJacobi qui me permet de calculer les valeurs propres et les vecteurs propres d'une matrice symétrique. En entrée, on dispose d'une matrice symétrique 3*3 et d'un critère de convergence. Le voici :

Function VVPrJacobi(pAA, pEpsilon As Double)

'---------------------------------------UTILISATION------------------------'
  ' Calcule les valeurs propres réelles et vecteurs propres associés
  ' d'une matrice symétrique par la méthode de Jacobi
  '
  ' Arguments :
  '    pAA       =  Matrice carrée dont on cherche les valeurs propres
  '    pEpsilon  =  Type Double. Critère de convergence

  ' Renvoie un tableau [(N+1)* N] avec les résultats complets :
  '   - Valeurs propres en ligne 1, triées dans l'ordre des modules décroissants
  '   - Vecteurs propres correspondants en colonnes
  '     sous les valeurs propres, de la ligne 2 à (N+1)
'------------------------------------------CODE----------------------------'
    Const MaxItér As Integer = 1000

    Dim MatA As Variant, MVctP As Variant, VPr As Variant, élément As Variant
    Dim Angle As Double, CosAngle As Double, SinAngle As Double
    Dim VMaxi As Double, iLig As Integer, jCol As Integer
    Dim ED As Double, Epsi As Double, Résidu As Double, Vtemp As Double

    Dim nn As Integer, itér As Integer
    Dim ii As Long, jj As Integer, kk As Integer

    'On Error GoTo GestionErreur

    ii = 0
    For Each élément In pAA
       ii = ii + 1
    Next élément
    nn = Sqr(ii)

    Epsi = nn * Abs(pEpsilon)

    ReDim VPr(1 To nn) As Double
    ReDim MatA(1 To nn, 1 To nn) As Double
    MatA = pAA

    ReDim MVctP(1 To nn, 1 To nn) As Double
    For ii = 1 To nn
        MVctP(ii, ii) = 1#
    Next ii

    For itér = 1 To MaxItér
        VMaxi = 0#
        iLig = 0:    jCol = 0
        For ii = 1 To nn
            For jj = (ii + 1) To nn
                If Abs(MatA(ii, jj)) > VMaxi Then
                    VMaxi = Abs(MatA(ii, jj))
                    iLig = ii:    jCol = jj
                End If
            Next jj
        Next ii

        ED = MatA(iLig, iLig) - MatA(jCol, jCol)
        If (ED <> 0) Then
            Angle = 0.5 * Atn(2# * MatA(iLig, jCol) / ED)
            CosAngle = Cos(Angle):         SinAngle = Sin(Angle)
        Else
            CosAngle = 0.5 * Sqr(2#):      SinAngle = CosAngle
        End If

        For kk = 1 To nn
            Vtemp = MatA(kk, iLig)
            MatA(kk, iLig) = CosAngle * Vtemp + SinAngle * MatA(kk, jCol)
            MatA(kk, jCol) = -SinAngle * Vtemp + CosAngle * MatA(kk, jCol)
            Vtemp = MVctP(kk, iLig)
            MVctP(kk, iLig) = CosAngle * Vtemp + SinAngle * MVctP(kk, jCol)
            MVctP(kk, jCol) = -SinAngle * Vtemp + CosAngle * MVctP(kk, jCol)
        Next kk

        MatA(iLig, iLig) = CosAngle * MatA(iLig, iLig) + SinAngle * MatA(jCol, iLig)
        MatA(jCol, jCol) = -SinAngle * MatA(iLig, jCol) + CosAngle * MatA(jCol, jCol)
        MatA(iLig, jCol) = 0#

        For kk = 1 To nn
            MatA(iLig, kk) = MatA(kk, iLig):    MatA(jCol, kk) = MatA(kk, jCol)
        Next kk

        Résidu = 0#
        For ii = 1 To (nn - 1)
            For jj = (ii + 1) To nn
                Résidu = Résidu + MatA(ii, jj) * MatA(ii, jj)
            Next jj
        Next ii
        Résidu = Sqr(2# * Résidu)

        If (Résidu < Epsi) Then
            For kk = 1 To nn
                VPr(kk) = MatA(kk, kk)
            Next kk

            For kk = 1 To nn
                For ii = 1 To (nn - 1)
                    If (Abs(VPr(ii + 1)) > Abs(VPr(ii))) Then
                        VMaxi = VPr(ii + 1)
                        VPr(ii + 1) = VPr(ii)
                        VPr(ii) = VMaxi
                        For jj = 1 To nn
                            VMaxi = MVctP(jj, ii + 1)
                            MVctP(jj, ii + 1) = MVctP(jj, ii)
                            MVctP(jj, ii) = Sgn(VPr(ii + 1)) * VMaxi
                        Next jj
                    End If
                Next ii
            Next kk

            ReDim MatA(1 To nn + 1, 1 To nn) As Double
            For ii = 1 To nn
                MatA(1, ii) = VPr(ii)
                For jj = 1 To nn
                    MatA(ii + 1, jj) = MVctP(ii, jj)
                Next jj
            Next ii

            VVPrJacobi = MatA

            Erase MatA, MVctP, VPr
            Exit Function
        End If
    Next itér

GestionErreur:
    ReDim VPr(1 To nn, 1 To 1) As Double
    VVPrJacobi = VPr
    MsgBox "Erreur dans la fonction VVPrJacobi() " & vbLf & vbLf & _
           "Type de l'erreur = " & Err.Description, vbExclamation, _
           "Erreur d'exécution"
End Function '-----------------------------------------

Je souhaite faire apparaitre la Matrice MatA dans ma feuille excel . pour cela je tape la fonction =VVPrJacobi(C3:E5;D7) dans la case C15. Et cela ne me sort qu'une valeur et non la matrice. Comment faire pour que ma matrice s'inscrive dans la plage (C15:E18)

Je vous ai mis un fichier d'exemple en PJ?

91classeur1.zip (17.69 Ko)

Bonjour,

Tu Sélectionnes la plage de cellules C15:E18 en inscrivant en C15 ta fonction.

Puis tu valides avec Ctrl+MAJ+Entrée

C'est une fonction matricielle

Cdlt

139classeur1.zip (20.22 Ko)

Merci beaucoup! Je savais que c'était un truc simple ^^ =)

Rechercher des sujets similaires à "sortie matricielle fonction vba"