Produits de deux matrices - VBA

mimy

XLDnaute Occasionnel
Bonjour à toutes et à tous,

Je voudrais faire le produit de deux matrices et coder une fonction sous VBA permettant de le faire. Et mettre un bouton qui affichera la matrice.
J ai pas mal de mal en vba donc je me tourne vers vous...

exemple:
-----A------------D------E-----F
1:__0.06___et ___1_____0.3___0.2
2:__0.02___et ___0.3___1_____0.4
3:__0.12___et ___0.2___0.4___1


Je voudrais obtenir la matrice suivante:
A1*A1*D1___A1*A2*E1___A1*A3*F1
A2*A1*D2___A2*A2*E2___A2*A3*F2
A3*A1*D3___A3*A2*E3___A3*A3*F3


Je vous remercie beaucoup
 

bbb38

XLDnaute Accro
Re : Produits de deux matrices - VBA

Bonsoir mimy, le forum,
Afin d’éviter de créer un fichier, peux-tu joindre un exemple simplifié ?
Précises dans quelques cellules, les résultats doivent s’afficher ?
Cordialement,
Bernard
 

mimy

XLDnaute Occasionnel
Re : Produits de deux matrices - VBA

Bonsoir bbb38,

J ai mis un fichier excel avec un exemple et avec les formules dans les cellules!

Merci beaucoup de vouloir m aider
 

Pièces jointes

  • Classeur1.xlsx
    9.1 KB · Affichages: 216

R@chid

XLDnaute Barbatruc
Re : Produits de deux matrices - VBA

Bonsoir @ tous,
On peut le faire par formule, comme suite,
en H3 :
Code:
=D3*$B3*DECALER($B$3;COLONNES($D:D)-1;)
@ tirer vers le bas et vers la droite.

Tu peux la convertir en VBA si tu sais le faire, mais moi je ne peux pas le faire en VBA

Amicalemen
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Produits de deux matrices - VBA

Bonsoir mimy,

Une essai en VBA (sans optimisation):
Code:
Function Corrrel_Covar(xEtype, xMatCorrel As Range)
Dim N As Long, i As Long, j As Long
If xEtype.Rows.Count = xMatCorrel.Rows.Count And _
   (xMatCorrel.Rows.Count = xMatCorrel.Columns.Count) Then
   N = xEtype.Rows.Count
   ReDim V(1 To xEtype.Rows.Count, 1 To xEtype.Rows.Count)
   For i = 1 To xEtype.Rows.Count
      For j = 1 To xEtype.Rows.Count
         V(i, j) = xEtype(i, 1) * xEtype(j, 1) * xMatCorrel(i, j)
      Next j
   Next i
   Corrrel_Covar = V
   Exit Function
End If
Corrrel_Covar = " Dimensions incohérentes"
End Function

Utilisation: Fonction renvoyant une matrice
Sélectionner C12:E14 (matrice carré de n lignes et colonnes; ici n=3)
Tapez sur F2 ou bien se placer avec la souris dans la barre d'édition des formules
Saisir la formule =Corrrel_Covar(B3:B5;D3:F5)
Valider par la combinaison des 3 touches Ctrl+Maj+Entrée (et non pas par la seule touche Entrée)

Edit : v2 avec bouton
 

Pièces jointes

  • De Correl à Covar v1.xls
    42.5 KB · Affichages: 120
  • De Correl à Covar v2.xls
    46.5 KB · Affichages: 115
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Produits de deux matrices - VBA

Bonsoir
En Excel :
Code:
=PRODUITMAT($B$3:$B$5;TRANSPOSE($B$3:$B$5))*$D$3:$F$5
validé par Ctrl+Maj+Entrée (in english: Ctrl+Shif+Enter)

En VBA pour l'installer:
VB:
Feuil1.[H13:J15].FormulaArray = "=MMULT(R3C2:R5C2,TRANSPOSE(R3C2:R5C2))*R3C4:R5C6"
Sinon évidemment pour l'avoir en tableau ça se fait tout seul en VBA par deux boucles imbriquées.

Cordialement
 
Dernière édition:

mimy

XLDnaute Occasionnel
Re : Produits de deux matrices - VBA

Bonjour tout le monde!!

Merci pour toutes vos reponses! Ca marche super bien!!
J ai notamment une question pour Mapomme!
Imaginons qu on ait n lignes d ecart type et donc une matrice de correlation nxn,
Est il possible, pour le calcul de la matrice variance covariance, de faire en sorte de ne pas declarer dans le code les longueurs de la plage d ecart type ainsi que celle de la matrice variance covariance?

Je vous remercie tous!!!
 

Dranreb

XLDnaute Barbatruc
Re : Produits de deux matrices - VBA

Bonsoir.
Dans sa fonction, mapomme n'a pas figé les longueurs de plages. Il les récupère des paramètres passés à la fonction.
Peut être auriez vous plutôt intérêt à écrire une procédure attachée à un bouton contenant ça à peu près :
VB:
Dim PlgRésu As Range, PlgÉTyp As Range, PlgCorr As Range, AdrÉTyp As String
Set PlgRésu = LàVousMettezLExpressionRangeQuIlFaut
Set PlgÉTyp = LàVousMettezLExpressionRangeQuIlFaut
Set PlgCorr = LàVousMettezLExpressionRangeQuIlFaut
AdrÉTyp = PlgÉTyp.Address(True, True, xlR1C1)
PlgRésu.FormulaArray = "=MMULT(" & AdrÉTyp & ",TRANSPOSE(" & AdrÉTyp & "))*" & PlgCorr.Address(True, True, xlR1C1)
P.S. Ça pourrait être ça, qui marche avec vos données, une règle générale de disposition étant supposée :
VB:
Sub test()
Dim PlgRésu As Range, PlgÉTyp As Range, PlgCorr As Range, Nbr As Long, AdrÉTyp As String
Set PlgÉTyp = ActiveSheet.Range("B3:B" & ActiveSheet.[B3].End(xlDown).Row)
Nbr = PlgÉTyp.Rows.Count
Set PlgCorr = PlgÉTyp.Offset(, 2).Resize(, Nbr)
Set PlgRésu = PlgCorr.Offset(, Nbr + 1)
AdrÉTyp = PlgÉTyp.Address(True, True, xlR1C1)
PlgRésu.FormulaArray = "=MMULT(" & AdrÉTyp & ",TRANSPOSE(" & AdrÉTyp & "))*" & PlgCorr.Address(True, True, xlR1C1)
End Sub
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Produits de deux matrices - VBA

Bonjour mimy et bonjour Dranreb,

Voici un essai avec quelques conditions pour l'utilisation des boutons:

On suppose que la matrice ' Ecart Type' commence à la cellule orange B3
On suppose que la matrice ' Corrélation' commence à la cellule verte D3
On suppose que la matrice ' Covariance' commence à la cellule verte A17

Il faudra adapter dans le module1 du code les valeurs des constantes sEcart, sCorr, sDest
Deux boutons ont été ajoutés:
Celui de mapomme qui déclenche la sub MatCorrCovar_mapomme qui utilise la fonction VBA Correl_Covar
Celui de Dranreb qui déclenche la sub MatCorrCovar_dranreb avec l'élégante formule de Dranreb et qui se suffit à elle-même.

Code:
Option Explicit

Const sEcart = "B3"  ' la cellule orange
Const sCorr = "D3"   ' la cellule verte
Const sDest = "A17"  ' la cellule jaune

Function Correl_Covar(xEtype, xMatCorrel As Range)
Dim N As Long, i As Long, j As Long
   If xEtype.Rows.Count = xMatCorrel.Rows.Count And _
      (xMatCorrel.Rows.Count = xMatCorrel.Columns.Count) Then
      N = xEtype.Rows.Count
      ReDim V(1 To xEtype.Rows.Count, 1 To xEtype.Rows.Count)
      For i = 1 To xEtype.Rows.Count
         For j = 1 To xEtype.Rows.Count
            V(i, j) = xEtype(i, 1) * xEtype(j, 1) * xMatCorrel(i, j)
         Next j
      Next i
      Correl_Covar = V
   Else
      Correl_Covar = " Dimensions incohérentes"
   End If
End Function

Sub MatCorrCovar_mapomme()

Dim rgEcart As Range, rgCorr As Range, rgDest As Range
Dim xEcart As Range, xCorr As Range, N As Long, i As Long

   Set rgEcart = Range(sEcart)
   Set rgCorr = Range(sCorr)
   Set rgDest = Range(sDest)
   
   For i = rgEcart.Row + 1 To Rows.Count
      If Cells(i, rgEcart.Column) = "" Then Exit For
   Next i
   N = i - rgEcart.Row
   Set xEcart = rgEcart.Resize(N)
   Set xCorr = rgCorr.Resize(N, N)
   rgDest.CurrentRegion.ClearContents
   rgDest.Resize(N, N) = Correl_Covar(xEcart, xCorr)
End Sub


Sub MatCorrCovar_Dranreb()

Dim rgEcart As Range, rgCorr As Range, rgDest As Range
Dim xEcart As Range, xCorr As Range, N As Long, i As Long

   Set rgEcart = Range(sEcart)
   Set rgCorr = Range(sCorr)
   Set rgDest = Range(sDest)
   
   For i = rgEcart.Row + 1 To Rows.Count
      If Cells(i, rgEcart.Column) = "" Then Exit For
   Next i
   N = i - rgEcart.Row
   Set xEcart = rgEcart.Resize(N)
   Set xCorr = rgCorr.Resize(N, N)
   rgDest.CurrentRegion.ClearContents
   rgDest.Resize(N, N).FormulaArray = "=MMULT(" & xEcart.Address(, , xlR1C1) & ",TRANSPOSE(" & xEcart.Address(, , xlR1C1) & "))*" & xCorr.Address(, , xlR1C1)
End Sub
 

Pièces jointes

  • De Correl à Covar v3.xls
    55 KB · Affichages: 85
Dernière édition:

mimy

XLDnaute Occasionnel
Re : Produits de deux matrices - VBA

Bonsoir à vous deux et je vous remercie pour votre réactivité!

J ai mis un fichier joint à ce message montrant qu il y a un bug et je ne sais pas pourquoi.
J ai seulement rajouté une ligne dans les écarts types et donc une ligne et colonne dans la matrice de correlation. Lorsque j appuie sur le bouton ça ne marche pas...

merci mille fois
 

Pièces jointes

  • De Correl à Covar v4.xls
    55 KB · Affichages: 76

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Produits de deux matrices - VBA

(re)Bonsoir mimy et Bonsoir Rachid,

Comme l'a dit justement Rachid il y a un mélange entre . et ,

C'est parce que mon Excel est paramétré avec comme séparateur le point décimal et non la virgule. J'ai rétabli la virgule comme séparateur et joint le fichier qui en découle.
 

Pièces jointes

  • De Correl à Covar v5.xls
    48.5 KB · Affichages: 117
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 489
Messages
2 088 852
Membres
103 974
dernier inscrit
chmikha