如何定义 DIAG 函数?

How to define a DIAG function?

我想定义一个 VBA 函数:

  1. returns矩阵主对角线元素的列向量;
  2. returns一个主对角线上有向量元素的对角方阵;
  3. 自动returns一个matrix/vector,无需按Ctrl Shift Enter;

我正在处理这段代码:

Public Function DIAG(matrix As Variant) As Variant

Dim i As Long
Dim j As Long
Dim nRows As Long
Dim nCols As Long
Dim tempArray As Variant

nRows = matrix.Rows.Count
nCols = matrix.Columns.Count

For i = 1 To nRows
    For j = 1 To nCols
        If i = j Then
           tempArray(i) = matrix(i, j)
        End If
    Next j
Next i

DIAG = tempArray

End Function

这只是为了功能的第一个目的,但它不起作用。我得到:

#VALUE

我认为您的应用程序结构有问题:您确定您的函数所在的模块可以从您的 Excel 工作簿访问吗?

举个例子,我做了一个类似的函数,我在我的 Excel 工作簿中使用它(在一个单元格中,我输入了公式 =DIAG(J5:Q25))并且一切正常,特此截图:

糟糕,我刚刚尝试了其他方法,但出现了相同的错误消息:

Public Function DIAG(matrix As Variant) As Variant
 Dim tempArray As Variant

 tempArray(1) = 1
 tempArray(2) = 2
 DIAG = tempArray
End Function

你确定你可以 return 整个矩阵甚至是一维数组作为函数的 return 并如此轻松地调用它吗?

为了您的信息,我试过了,在一个单元格中使用 =DIAG(J5:Q25),在两个单元格中,并作为一个数组公式。

你的函数returns调用UDF时出现这样的错误,如果我正确理解你想要什么,请使用下一个适配的函数:

Public Function DIAG(matrix As Range) As Variant
 Dim i As Long, j As Long, k As Long, nRows As Long, nCols As Long
 Dim tempArray As Variant

 nRows = matrix.Count: nCols = matrix.Columns.Count

 ReDim tempArray(nRows * nCols) 'without this step it will return an error when try loading
 For i = 1 To nRows
    For j = 1 To nCols
        If i = j Then
           tempArray(k) = matrix(i, j): k = k + 1
        End If
    Next j
 Next i
 ReDim Preserve tempArray(k - 1) 'preserving only the elements keeping data
 DIAG = tempArray
End Function

中间数组应该是 ReDim 然后只保留保留数据的元素...

结束语句(@Dominique 建议):如果您创建一个用户定义的函数,称为 UDF,则首先通过在宏中调用它来测试它,并且仅当这 returns 你需要的时候,没有任何错误,你可以直接从单元格调用它。

@FaneDuru 的代码确实帮助了我,但我用这种方式成功地编写了我的 UDF:

Public Function DIAG(matrix As Range) As Variant

Dim i As Long, j As Long, nRows As Long, nCols As Long
Dim tempArray As Variant

nRows = matrix.Rows.Count
nCols = matrix.Columns.Count

If nCols = 1 Then
 
 ReDim tempArray(nRows - 1, nRows - 1)

 For i = 1 To nRows
  tempArray(i - 1, i - 1) = matrix(i)
 Next i

Else

 If nCols = nRows Then

 ReDim tempArray(nRows - 1, 0)

 For i = 1 To nRows
  For j = 1 To nCols
   If i = j Then
    tempArray(i - 1, 0) = matrix(i, j)
   End If
  Next j
 Next i

 Else
  tempArray = CVErr(xlErrValue)
 End If

End If

DIAG = tempArray

End Function