VBA - 通过Application.Evaluate

Question

假设我们在单元格 A1 中保存了一些长公式：

=SomeArrayFunction(
IF(SUM(D3:D6)>1,"A-B-C-D-E-F-G-H-I-J-K-L-M-N-O-P-Q-R-S-T-U-V-W-X 01",
"part_one"),
IF(SUM(D3:D6)>1,"A-B-C-D-E-F-G-H-I-J-K-L-M-N-O-P-Q-R-S-T-U-V-W-X 02",
IF(SUM(D3:D6)>1,"A-B-C-D-E-F-G-H-I-J-K-L-M-N-O-P-Q-R-S-T-U-V-W-X 03",
"part_two"))
)

使用以下VBA函数

Public Function SomeArrayFunction(sOne As String, sTwo As String) As Variant
    Dim V() As Variant
    ReDim V(1 To 2, 1 To 1)
    V(1, 1) = sOne
    V(2, 1) = sTwo
    SomeArrayFunction = V
End Function

返回2×1阵列。

现在我调用这个VBA函数

Public Sub EvaluateFormula()
    Dim vOutput As Variant

    vOutput = Application.Evaluate(Selection.Formula)

    If VarType(vOutput) >= vbArray Then
        MsgBox "Array:" & vbCrLf & vOutput(1, 1) & vbCrLf & vOutput(2, 1)
    Else
        MsgBox "Single Value: " & vbCrLf & vOutput
    End If
End Sub

选择单元格 A1 时出现错误，因为Application.Evaluate无法处理超过255个字符的公式（例如，请参阅VBA - Error when using Application.Evaluate on Long Formula）。另一方面，如果我写

vOutput = Application.Evaluate(Selection.Address)

相反（如上面的链接中所提出的），然后它工作得很好。除了数组不再被重新编号的事实，即 MsgBox“Single Value：”被调用而不是 MsgBox“Array：”。

所以我的问题是：如何使用VBA评估长公式（返回数组）？

编辑：让我强调，当我只选择具有公式的一个单元格（不是一个区域或多个单元格）时，我需要这个。我没有把它作为数组公式输入（即没有花括号）：

编辑2：让我回答一下原因：我目前的工作要求我在电子表格中列出这么大的公式列表。由于它们按列表组织，因此每个这样的公式只能占用一个单元格。在几乎所有情况下，公式都返回单个值（因此一个单元格足以存储/显示输出）。但是，当评估公式时出现内部错误时，公式将返回错误消息。这些错误消息通常很长，因此返回为不同大小的数组（取决于错误消息的长度）。所以我的目标是编写一个VBA函数，该函数首先从列表中获取并输出给定​​选定条目的完整错误消息。

Answer 1

我相信Application.Evaluate将返回与输入地址大小相匹配的结果。我怀疑你的Selection是一个单元格，所以它返回一个值。

如果您使用Selection.CurrentArray.Address调用它，您将获得与正确数组大小相同的答案。

VBA和Excel的图片

使用

进行测试的代码

Public Function Test() As Variant

    Test = Array(1, 2)


End Function

Sub t()

    Dim a As Variant

    a = Application.Evaluate(Selection.CurrentArray.Address)

End Sub

编辑，根据此处的评论，可以通过创建新工作表来评估此工作表。我使用剪切/粘贴方法来确保公式都一致。如果细胞不参考切割的细胞，这可能会更好。因为我使用剪切/粘贴，所以在技术上不会打破任何其他细胞。

在下面的代码中，我在单元格J2中有一个数组公式，它引用了其他几个单元格。它被扩展为3行，然后进行Evaluate调用。返回一个你想要的数组。然后它将它缩小到一个单元并将其移回。

我已经测试了一个简单的例子。我不知道它是否适合您的应用程序。

Sub EvaluateArrayFormulaOnNewSheet()

    'cut cell with formula
    Dim str_address As String
    Dim rng_start As Range
    Set rng_start = Sheet1.Range("J2")
    str_address = rng_start.Address

    rng_start.Cut

    'create new sheet
    Dim sht As Worksheet
    Set sht = Worksheets.Add

    'paste cell onto sheet
    Dim rng_arr As Range
    Set rng_arr = sht.Range("A1")
    sht.Paste rng_arr

    'expand array formula size.. resize to whatever size is needed
    rng_arr.Resize(3).FormulaArray = rng_arr.FormulaArray

    'get your result
    Dim v_arr As Variant
    v_arr = Application.Evaluate(rng_arr.CurrentArray.Address)

    ''''do something with your result here... it is an array


    'shrink the formula back to one cell
    Dim str_formula As String
    str_formula = rng_arr.FormulaArray

    rng_arr.CurrentArray.ClearContents
    rng_arr.FormulaArray = str_formula

    'cut and paste back to original spot
    rng_arr.Cut

    Sheet1.Paste Sheet1.Range(str_address)

    Application.DisplayAlerts = False
    sht.Delete
    Application.DisplayAlerts = True

End Sub

Answer 2

尝试

 vOutput = Application.Evaluate(Selection.CurrentArray.Address)

（假设您有两个单元格，=SomeArrayFunction(...)作为数组公式输入）

我认为差异可能是评估单个单元格只会获得返回到该单元格的值：整个数组不会返回那里，只返回第一个值。