VBA produit des termes diagonaux d'une matrice

Bonjour,

Je suppose donc qu'il s'agit d'une matrice carrée :o)

Voici une fonction à ajouter dans un module que semble fonctionner.

Public Function ProdDiag(OUSSA As Variant) As Variant
If VarType(OUSSA) = 8204 Then
Koi = OUSSA
Hau = UBound(Koi, 1): Lar = UBound(Koi, 2)
If Hau = Lar Then
Bid = 1
For I = 1 To Hau
Bid = Bid * OUSSA(I, I)
Next
ProdDiag = Bid
Else
ProdDiag = CVErr(xlErrRef)
End If
Else
ProdDiag = CVErr(xlErrRef)
End If
End Function

Si l'argument saisi n'est pas un tableau carré,
cela provoque l'erreur #REF.


Exemple d'appel dans une feuille : =ProdDiag(E3:G5)

Cordialement,

HB

Le 25/02/2016 00:29, benn09 a écrit :

Bonjour,
je cherche un algorithme pour calculer le produit des termes diagonaux d'une
matrice en l'affichant sur la feuille excel
et merci d'avance

---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus

Bonjour,

Tu aurais pu définir davantage le genre de matrice
qui est l'objet de ton projet...

Un autre exemple,

Supposons 2 colonnes dans une feuille de calcul
à l'aide d'un tableau, on peut inverses ses valeurs

'------------------------------------------------
Sub test()
Dim Arr(), Arr1()
Dim A As Long, B As Long, C As Long, D As Long

With Worksheets("Feuil1")
With .Range("A1:B10")
Arr = .Value
'Définir le tableau pour le tableau inversé
'selon la grandeur du tableau
ReDim Arr1(1 To .Columns.Count, 1 To .Rows.Count)
End With

'une simple boucle
'Pour chaque colonne, de la plus grande à la plus petite
For A = UBound(Arr, 2) To LBound(Arr, 2) Step -1
C = C + 1
'Pour chaque ligne, de la plus grande à la plus petite
For B = UBound(Arr, 1) To LBound(Arr, 2) Step -1
D = D + 1
Arr1(C, D) = Arr(B, A)
Next
D = 0
Next
.Range("G1").Resize(UBound(Arr1, 2), UBound(Arr1, 1)) = _
Application.Transpose(Arr1)
End With
End Sub
'------------------------------------------------

MichD

Tu peux transformer mon exemple en utilisant une fonction
pour reverser le tableau. La fonction peut s'appliquer à
divers tableaux!


'------------------------------------------------
Sub test()
Dim Arr(), Arr1(), Rg As Range, T()
Dim A As Long, B As Long, C As Long, D As Long

With Feuil1
With .Range("A1:C10")
T = .Value
T = Reverste_Tableau(T)
End With
.Range("G1").Resize(UBound(T, 2), UBound(T, 1)).Value = _
Application.Transpose(T)
End With
End Sub
'------------------------------------------------

Function Reverste_Tableau(T()) As Variant
Dim Arr(), A As Long, B As Long, C As Long, D As Long
ReDim Arr(1 To UBound(T, 2), 1 To UBound(T, 1))

For A = UBound(T, 2) To LBound(T, 2) Step -1
C = C + 1
For B = UBound(T, 1) To LBound(T, 2) Step -1
D = D + 1
Arr(C, D) = T(B, A)
Next
D = 0

Next
Reverste_Tableau = Arr
End Function
'------------------------------------------------


MichD

Le jeudi 25 Février 2016 à 14:37 par MichD :

Tu peux transformer mon exemple en utilisant une fonction
pour reverser le tableau. La fonction peut s'appliquer à
divers tableaux!


'------------------------------------------------
Sub test()
Dim Arr(), Arr1(), Rg As Range, T()
Dim A As Long, B As Long, C As Long, D As Long

With Feuil1
With .Range("A1:C10")
T = .Value
T = Reverste_Tableau(T)
End With
.Range("G1").Resize(UBound(T, 2), UBound(T, 1)).Value = _
Application.Transpose(T)
End With
End Sub
'------------------------------------------------

Function Reverste_Tableau(T()) As Variant
Dim Arr(), A As Long, B As Long, C As Long, D As Long
ReDim Arr(1 To UBound(T, 2), 1 To UBound(T, 1))

For A = UBound(T, 2) To LBound(T, 2) Step -1
C = C + 1
For B = UBound(T, 1) To LBound(T, 2) Step -1
D = D + 1
Arr(C, D) = T(B, A)
Next
D = 0

Next
Reverste_Tableau = Arr
End Function
'------------------------------------------------


MichD

merci beaucoup pour votre réponse
et j'ai trouver une solution assez simple

Function Prod(M As udtMatrice) As Double
Dim i As Integer
Prod = 1

For i = 0 To M.NbrCol - 1

Prod = Prod * M.Coef(i, i)

Next i
MsgBox ("le produit des termes diagonaux" & Prod)
End Function

Sub Produit()
Dim M As udtMatrice

M.NbrCol = InputBox(" le nombre de colonne")

M.nom = InputBox("quel est le nom de la matrice")
M = initmat(M.NbrCol, M.NbrCol, M.nom)
Call Prod(M)
Call dispmat(M)
End Sub

Bonjour,

Visiblement, il manque une partie du code
dans ce que tu nous transmets ...
(Type UdtMatrice ? sub initmat ? et sub dispmat ? )

Enfin, une msgbox dans une fonction c'est plutôt curieux comme procédé.


Par ailleurs, cette solution ne correspond pas franchement à la question
initiale.
si j'ai bien compris, il s'agissait de récupérer (simplement) le produit
des termes diagonaux d'une matrice (carrée) (présente sur une feuille)
en l'ajoutant (ce produit) sur la feuille (dans une cellule).

Ce qui est entre parenthèse sont des suppositions, certes, mais cela me
semble logique.

Je ne vois pas trop l'avantage d'une méthode qui utilise des boîte de
dialogue. Une fonction personnalisée remplit pleinement ce rôle
et est plus souple ...

Ou bien ... aurais-je mal compris la question ?

Cordialement,

HB

Le 25/02/2016 22:58, benn09 a écrit :

merci beaucoup pour votre réponse
et j'ai trouver une solution assez simple

Function Prod(M As udtMatrice) As Double
Dim i As Integer
Prod = 1

For i = 0 To M.NbrCol - 1

Prod = Prod * M.Coef(i, i)

Next i
MsgBox ("le produit des termes diagonaux" & Prod)
End Function

Sub Produit()
Dim M As udtMatrice

M.NbrCol = InputBox(" le nombre de colonne")

M.nom = InputBox("quel est le nom de la matrice")
M = initmat(M.NbrCol, M.NbrCol, M.nom)
Call Prod(M)
Call dispmat(M)
End Sub

---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus