在Excel中，经常存在一个单元格引用另一个单元格中，而另一个单元格又引用其他单元格的情形。如何使用VBA代码编程确定指定单元格的所有引用单元格呢？
引用单元格是由公式引用并在 Excel 的计算树中识别的单元格。例如，如果在单元格A1中有公式=B2，那么单元格B2是单元格A1的引用单元格；如果在单元格B2中也有公式=C3，那么单元格B2（第一级）和单元格C3（第二级）都是单元格A1的引用单元格。
可以单击功能区“公式”选项卡“公式审核”组中的“追踪引用单元格”来追踪引用的单元格，如下图1所示。
图1
根据VBA帮助文件，Range.Precedents属性返回一个Range对象，代表所有引用的单元格。因此，编写下面的代码：
代码语言：javascript复制Sub test()
Dim rngToCheck As Range
Dim rngPrecedents As Range
Dim rngPrecedent As Range
Set rngToCheck = Range("A1")
On Error Resume Next
Set rngPrecedents = rngToCheck.Precedents
On Error GoTo 0
If rngPrecedents Is Nothing Then
Debug.Print rngToCheck.Address(External:=True) & "没有引用单元格."
Else
For Each rngPrecedent In rngPrecedents
Debug.Print rngPrecedent.Address(External:=True)
Next rngPrecedent
End If
End Sub针对图1所示的工作表，上面代码的输出结果如下图2所示。
图2
立即窗口中的输出告诉我们，Precedents属性适用于这个简单的示例，但是这个示例和帮助文件没有告诉我们的是它不会返回其他工作表或其他工作簿上的引用单元格。这个限制由Range.Precedents属性的定义所限制，因为该属性返回一个Range对象，而Range对象不能跨不同工作表引用单元格区域。
一种针对Range.Precedents属性不足的解决方案是使用Range.ShowPrecedents方法显示导航箭头，然后使用Range.NavigateArrow方法沿着每个箭头导航。
然而，还可以使用递归编程技术来解决。这也是展示递归技术的一个极好的示例。
代码如下：
代码语言：javascript复制Sub test2()
Dim rngToCheck As Range
Dim dicAllPrecedents As Object
Dim i As Long
Set rngToCheck = Sheet1.Range("A1")
Set dicAllPrecedents = GetAllPrecedents(rngToCheck)
Debug.Print "= = ="
If dicAllPrecedents.Count = 0 Then
Debug.Print rngToCheck.Address(External:=True); "没有引用单元格."
Else
For i= LBound(dicAllPrecedents.keys) To UBound(dicAllPrecedents.keys)
Debug.Print "[ 层级:"; dicAllPrecedents.items()(i); " ]";
Debug.Print "[ 地址:"; dicAllPrecedents.keys()(i); " ]";
Debug.Print vbCrLf
Nexti
End If
Debug.Print "= = ="
End Sub
'不能遍历关闭的工作簿中的引用单元格
'不能遍历受保护工作表中的引用单元格
'不能识别隐藏工作表中的引用单元格
Public Function GetAllPrecedents(ByRef rngToCheckAs Range) As Object
Const lngTOP_LEVEL As Long = 1
Dim dicAllPrecedents As Object
Dim strKey As String
Set dicAllPrecedents = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
GetPrecedents rngToCheck, dicAllPrecedents, lngTOP_LEVEL
Set GetAllPrecedents = dicAllPrecedents
Application.ScreenUpdating = True
End Function
Private Sub GetPrecedents(ByRef rngToCheck As Range, ByRef dicAllPrecedents As Object, ByVal lngLevel As Long)
Dim rngCell As Range
Dim rngFormulas As Range
If Not rngToCheck.Worksheet.ProtectContents Then
If rngToCheck.Cells.CountLarge > 1 Then
On Error Resume Next
Set rngFormulas = rngToCheck.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
Else
If rngToCheck.HasFormula Then Set rngFormulas = rngToCheck
End If
If Not rngFormulas Is Nothing Then
For Each rngCell In rngFormulas.Cells
GetCellPrecedents rngCell, dicAllPrecedents, lngLevel
Next rngCell
rngFormulas.Worksheet.ClearArrows
End If
End If
End Sub
Private Sub GetCellPrecedents(ByRef rngCell As Range, ByRef dicAllPrecedents As Object, ByVal lngLevel As Long)
Dim lngArrow As Long
Dim lngLink As Long
Dim blnNewArrow As Boolean
Dim strPrecedentAddress As String
Dim rngPrecedentRange As Range
Do
lngArrow = lngArrow 1
blnNewArrow = True
lngLink = 0
Do
lngLink = lngLink 1
rngCell.ShowPrecedents
On Error Resume Next
Set rngPrecedentRange = rngCell.NavigateArrow(True, lngArrow, lngLink)
If Err.Number <> 0 Then
Exit Do
End If
On Error GoTo 0
strPrecedentAddress =rngPrecedentRange.Address(False, False, xlA1, True)
If strPrecedentAddress = rngCell.Address(False, False, xlA1, True) Then
Exit Do
Else
blnNewArrow = False
If Not dicAllPrecedents.exists(strPrecedentAddress) Then
dicAllPrecedents.Add strPrecedentAddress, lngLevel
GetPrecedents rngPrecedentRange, dicAllPrecedents, lngLevel 1
End If
End If
Loop
If blnNewArrow Then Exit Do
Loop
End SubGetAllPrecedents函数返回一个Dictionary对象，包含键中的单元格区域地址和项中的引用单元格层级。代码中最重要的概念是递归：GetPrecedents过程和GetCellPrecedents过程一遍又一遍地相互调用，直到它们遍历完引用单元格。对代码功能的一个简单增强是对它可以到达的层级数添加了限制：在递归技术中经常需要设置这样的限制。
注意，这段代码不会遍历关闭的工作簿或受保护的工作表追踪引用单元格，也不会在隐藏的工作表中找到引用单元格。
GetAllPrecedents函数可能会返回重叠的地址，例如B2:B10和B4，因为它使用联合单元格区域地址以提高效率。当代码沿引用单元格树导航时，如果它遇到之前导航过的单元格，将忽略它。同样，这是出于效率的目的。该函数不能作为自定义函数工作，因为当调用者是Range时，Range.ShowPrecedents和Range.NavigateArrows方法被禁用。
在代码中使用了Range.CountLarge，如果使用的是Excel2003或更早版本，则需要将其更改为Range.Count。
在Excel2010之前的版本中，Range.SpecialCells的返回值限制为8,192个不连续的单元格。你不可能打破此限制。
注：本文学习整理自colinlegg.wordpress.com，供有兴趣的朋友参考。
