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