Excel是否有内置的方法来解析公式?(即:获取包含的RANGE参考列表)

tbo*_*one 6 excel vba excel-vba

对于单元格中的给定Excel公式,我希望能够解析公式,以获得公式中包含的Excel范围引用列表.

例如,如果我有一个具有此公式的单元格:

= A + 25 + B  
Run Code Online (Sandbox Code Playgroud)

....我希望能够得到公式中包含的一系列excel范围,所以在这种情况下,它将包含[A]和[B]

"为什么你甚至想要这样做?",我可以听到你问:
我想要这样做的一个例子就是在公式中查找范围的"标签".....所以,而不是仅仅执行CTRL +〜查看工作表中的公式,我想选择以编程方式访问公式中的范围引用,以便查找目标范围旁边的标签.

所以,在上面的例子中,我可以编写类似下面的公式:

=Offset(CellFormulaRanges('TheAddressMyFormulaIsIn',1),0,-1)
=Offset(CellFormulaRanges('TheAddressMyFormulaIsIn',2),0,-1)
Run Code Online (Sandbox Code Playgroud)

...这会给我公式中第1和第2范围左边的标签.

这样做将会对已经在Excel本身的一些功能调用,如手工编写公式解析器是一个复杂的任务:
http://ewbi.blogs.com/develops/2004/12/excel_formula_p.html

tbo*_*one 5

感谢@TimWilliams 和@brettdj 为我指明了之前有关该主题的讨论的正确方向,我可以自信地说:

不,Excel 没有解析方法。

然而,出于我相当小的目的,我想出了一些可以工作、可以与跨工作表引用一起工作并且可以从 UDF 调用的东西。

然而,它非常脆弱,并且有许多完全合法的公式,我确信它无法正确处理。

代码很乱,可以大大改进,但我只是想把它放在这里,因为我暂时要转向其他事情......

编辑

还发现了这个,看起来很有趣:
http://www.dailydoseofexcel.com/archives/2009/12/05/formula-tokenizer/

Public Function CellPrecedents(cell As Range) As Variant()
    Dim resultRanges As New Collection
    If cell.Cells.count <> 1 Then GoTo exit_CellPrecedents
    If cell.HasFormula = False Then GoTo exit_CellPrecedents

    Dim formula As String
    formula = Mid(cell.formula, 2, Len(cell.formula) - 1)

    If IsRange(formula) Then
        resultRanges.Add Range(formula), 1
    Else
        Dim elements() As String
        'Debug.Print formula & " --> "
        formula = Replace(formula, "(", "")
        formula = Replace(formula, ")", "")
        'Debug.Print formula & " --> "
        elements() = SplitMultiDelims(formula, "+-*/\^")
        Dim n As Long, count As Integer
        For n = LBound(elements) To UBound(elements)
            If IsRange(elements(n)) Then
                'ACTUALLY JUST DO A REDIM PRESERVE HERE!!!!
                count = count + 1
                'resultRanges.Add Range(Trim(elements(n)))  '<---  Do **NOT** store as a range, as that gets automatically Eval()'d
                resultRanges.Add Trim(elements(n))
            End If
        Next
    End If

    Dim resultRangeArray() As Variant
    ReDim resultRangeArray(resultRanges.count)
    Dim i As Integer
    For i = 1 To resultRanges.count
        resultRangeArray(i) = CStr(resultRanges(i))  '// have to store as a string so Eval() doesn't get invoked (I think??)
    Next

    CellPrecedents = resultRangeArray

exit_CellPrecedents:
    Exit Function
End Function

Public Function IsRange(var As Variant) As Boolean
    On Error Resume Next
    Dim rng As Range: Set rng = Range(var)
    If err.Number = 0 Then IsRange = True
End Function
Run Code Online (Sandbox Code Playgroud)

(只需谷歌 SplitMultiDelims 即可获得该功能)

  • https://github.com/spreadsheetlab/XLParser 是一个更专注的例子。 (2认同)