从VBA中recursion地提取公式中的值

我想recursion地查找一个范围对象的公式，直到find它所组成的每一个单一的值。 由于我对前面句子的语法正确性不太确定（无论如何，我为我的英语道歉），我会试着用一个例子来解释我想要达到的目的（希望这可能是最简单的一个）：

mysheet = "Sheet1" Sheets(mysheet).Range("A1").Formula = "=+B1" Sheets(mysheet).Range("B1").Formula = "=+C1-C2" Sheets(mysheet).Range("C1").Value = "value:val1" Sheets(mysheet).Range("C2").Formula = "=+D1-D2" Sheets(mysheet).Range("D1").Value = "value:val2" Sheets(mysheet).Range("D2").Value = "value:val3" 

你能给我一个提示（或更好的代码草稿）什么样的函数（recursion的，也许？）可以返回一个string（让我们称之为my_formula），使命令

  MsgBox(my_formula) 

将返回以下内容：

  A1 = +value:val1 - value:val2 + value:val3 

？ 请帮帮我

谢谢

更新后不到一小时

大家好，非常感谢你的回答。 我会指出，单元格中的值是有效的string+我只是简单的操作（+和 – ）+所有的依赖是在同一张表+我没有范围，如$ X $ 1。 然而，我知道你们中的一些人（先例，NavigateArrow …）发布的方法/属性，但是我所问的是如何以最好的方式使用这种方法/属性而不会感到头疼的想法。

再次感谢你

Answer 1

这个代码将适用于你的例子 – 但YMMV将如何在现实生活中扩展到更复杂的公式。 然而，它会让你开始 – 然后是一些 – 如何缓和Range的Precedents集合。 我已经评论了代码，但理解它的最简单的方法是在debugging模式下使用F8。

 Option Explicit Sub Test() Dim ws As Worksheet Dim rng As Range Dim strOutput As String 'your test case from the original question Set ws = ThisWorkbook.Sheets("Sheet1") With ws .Range("A1").Formula = "=+B1" .Range("B1").Formula = "=+C1-C2" .Range("C1").Value = "10" .Range("C2").Formula = "=+D1-D2" .Range("D1").Value = "20" .Range("D2").Value = "30" End With 'the cell you want to start from Set rng = Sheet1.Range("A1") 'get the output from calling the recursive function 'note we pass the original formula in to kick off the function strOutput = rng.Address(0, 0) & GetFullFormula(rng, rng.Formula) 'show user MsgBox strOutput End Sub Function GetFullFormula(rng As Range, strFormula As String) As String Dim rngPrecedents As Range Dim rngPrecedent As Range Dim strPrecedentAddress As String Dim strPrecedentFormula As String If rng.HasFormula Then Set rngPrecedents = rng.Precedents For Each rngPrecedent In rngPrecedents 'get the precedent cell address to check if in current formula (without $) strPrecedentAddress = rngPrecedent.Address(0, 0) 'Debug.Print strFormula 'substiute into formula if matching a range address If rngPrecedent.HasFormula Then If InStr(1, strFormula, strPrecedentAddress, vbBinaryCompare) Then 'strip = from formula and put in brackets to preserve ordering strPrecedentFormula = "(" & Mid(rngPrecedent.Formula, 2, Len(rngPrecedent.Formula) - 1) & ")" 'replace our formula with precedent formula strFormula = Replace(strFormula, strPrecedentAddress, strPrecedentFormula) End If 'carry on with recursion - passes formula back into function for expansion GetFullFormula rngPrecedent, strFormula Else 'just a value If InStr(1, strFormula, strPrecedentAddress, vbBinaryCompare) Then 'replace the address with the value strFormula = Replace(strFormula, strPrecedentAddress, rngPrecedent.Value) End If End If Next rngPrecedent End If GetFullFormula = strFormula End Function 

输出：

 =+(+10-(+20-30)) 

如果您使用像$A$1这样的单元格引用，这个代码将会出现问题，因为该函数需要纯引用单元格。 代码可以扩展来处理这些情况，并命名范围，但这只是一个基本的例子。