Produits de deux matrices - VBA

  • Initiateur de la discussion Initiateur de la discussion mimy
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
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
 
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
 
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

Dernière édition:
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:
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!!!
 
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:
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

Dernière édition:
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

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

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
0
Affichages
289
Réponses
3
Affichages
290
Réponses
10
Affichages
588
Réponses
10
Affichages
800
  • Question Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
390
Retour