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?
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
Merci beaucoup! Je savais que c'était un truc simple ^^ =)