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
感谢@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 即可获得该功能)