Return 只有一个矩阵中的对角线值（在其他单元格中为零）到具有相同维度的另一个矩阵

Question

我必须通过收缩因子 (lambda) 将方差-协方差矩阵中的值向方差（矩阵中的对角线值）收缩，因此： lambda*shrinkagematrix+(1-lambda)*variancecovariancematrix，其中：

方差协方差矩阵为：

Function VarCovar(rng As Range) As Variant
    Dim i As Integer
    Dim j As Integer
    Dim numcols As Integer

    numcols = rng.Columns.Count
    numrows = rng.Rows.Count

    Dim matrix() As Double
    ReDim matrix(numcols - 1, numcols - 1)

    For i = 1 To numcols
        For j = 1 To numcols
            matrix(i - 1, j - 1) = Application.WorksheetFunction.Covar(rng.Columns(i), rng.Columns(j)) * numrows / (numrows - 1)
        Next j
    Next i
    VarCovar = matrix

，这给了我一个看起来像这样的矩阵：

 0.40  -0.10  0.11                                                 
-0.10   0.17 -0.03                                              
 0.11  -0.03  0.19

然后我在创建应该如下所示的收缩矩阵时遇到了问题：

0.40  0.00  0.00                                      
0.00  0.17  0.00                                              
0.00  0.00  0.19

即 return 仅对角线值（=变量的方差）和所有其他单元格中的零。

所以以某种方式，使它 return 成为一个仅包含行=列号时的值的矩阵，即 (1,1)、(2,2) 和 (3,3) 值。

有人可以帮忙吗？

Answer 1

您只需要一个循环，从 i = 1 to 3 开始使用 Matrix(i, i)

填充 Matrix(1, 1)、Matrix(2, 2) 和 Matrix(3, 3)

Function VarCovar(InputMatix As Range) As Variant
    Dim MatrixColumns  As Long
    MatrixColumns = InputMatix.Columns.Count

    Dim MatrixRows  As Long
    MatrixRows = InputMatix.Rows.Count

    Dim Matrix() As Double
    ReDim Matrix(1 To MatrixColumns, 1 To MatrixColumns)

    Dim i As Long
    For i = 1 To MatrixColumns
        Matrix(i, i) = Application.WorksheetFunction.Covar(InputMatix.Columns(i), InputMatix.Columns(i)) * MatrixRows / (MatrixRows - 1)
    Next i

    VarCovar = Matrix
End Function

请注意，我将 Matrix 维度 Matrix(1 To MatrixDimension, 1 To MatrixDimension) 更改为以 1 而不是 0 开头，因此您可以轻松地使用它来将其写入单元格：

Sub test()

    Range("A5:C7").Value = VarCovar(Range("A1:C3"))

End Sub

Return 只有一个矩阵中的对角线值（在其他单元格中为零）到具有相同维度的另一个矩阵

Return only diagonal values (zero in the other cells) in one matrix to another matrix with same dimensions

excel

vba

matrix

covariance