仅将一个矩阵中的对角线值（在其他单元格中为零）返回到具有相同尺寸的另一个矩阵

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 

然后我在创建Shrinkage矩阵时遇到问题，该矩阵看起来像：

0.40  0.00  0.00                                      
0.00  0.17  0.00                                              
0.00  0.00  0.19 

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

因此，以某种方式，使其返回仅包含row =列号的值的矩阵，即（1,1），（2,2）和（3,3）值。

有人可以帮忙吗？

Answer 1

你只需要一个从i = 1 to 3计算的循环来填充Matrix(1, 1)，Matrix(2, 2)和Matrix(3, 3)使用Matrix(i, i)

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

请注意，我更改了qazxsw poi维度qazxsw poi以qazxsw poi而不是Matrix开头，因此您可以轻松地将其用于将其写入单元格：

Matrix(1 To MatrixDimension, 1 To MatrixDimension)