Excelmacros – 查找使用离题的单元格
我使用标准的财务单元格格式，其中input是蓝色的，引用任何离页的单元格是绿色的，而其他一切都是黑色的。
一切都很好 – 我有能力开发基本上做了GoTo – >常量 – >数字和GoTo – >公式的macros，然后在公式文本中查找“！” 符号。
然而，是否有办法select和突出显示所有使用离页的单元格（例如用紫色表示），而不pipe它们是否作为常量或公式或原始表单上的任何内容input？
即：我希望能够通过macros快速查找和识别任何使用offsheet的单元格。 一般来说，我擅长制作macros，但不能想出任何可以实现这一点的function。 任何人都可以给我一个提示让我开始正确的方向吗？
编辑：我到目前为止：
Sub Offsheet_Dependents() Dim xRg As Range Dim xCell As Range Dim xTxt As String On Error Resume Next xTxt = ActiveWindow.RangeSelection.Address Set xRg = Application.InputBox("Please select the data range:", "EDI macro", xTxt, , , , , 8) If xRg Is Nothing Then Exit Sub ' Need to modify the below for loop to only highlight cells where the reference is offsheet. Currently higlights entire range. ' also need to add a cell.cleararrows command somewhere and have it work For Each cell In xRg cell.ShowDependents Worksheet.cell.NavigateArrow TowardPrecedent:=False, ArrowNumber:=1, LinkNumber:=1 If ActiveCell.Worksheet.Name <> Worksheet.cell.Worksheet.Name Then cell.Interior.Color = RGB(204, 192, 218) End If xRg.Select.ActiveSheet.ClearArrows Next End Sub 另一种可能性，但第二个macros没有成功应用第一个跨越范围:(：
Sub Color_Dependents() Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer Dim stMsg As String Dim bNewArrow As Boolean Application.ScreenUpdating = False ActiveCell.ShowDependents Set rLast = ActiveCell iArrowNum = 1 iLinkNum = 1 bNewArrow = True Do Do Application.Goto rLast On Error Resume Next ActiveCell.NavigateArrow Towardprecedent:=False, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum If Err.Number > 0 Then Exit Do On Error GoTo 0 If rLast.Address(External:=True) = ActiveCell.Address(External:=True) Then Exit Do bNewArrow = False If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then If rLast.Worksheet.Name = ActiveCell.Parent.Name Then ' local stMsg = stMsg & vbNewLine & Selection.Address Else stMsg = stMsg & vbNewLine & "'" & Selection.Parent.Name & "'!" & Selection.Address End If Else ' external stMsg = stMsg & vbNewLine & Selection.Address(External:=True) End If iLinkNum = iLinkNum + 1 ' try another link Loop If bNewArrow Then Exit Do iLinkNum = 1 bNewArrow = True iArrowNum = iArrowNum + 1 'try another arrow Loop rLast.Parent.ClearArrows Application.Goto rLast If stMsg Like "*!*" Then ActiveCell.Interior.Color = RGB(204, 192, 218) End If End Sub Sub Purple_Range() Dim xRg As Range Dim xCell As Range Dim xTxt As String On Error Resume Next xTxt = ActiveWindow.RangeSelection.Address Set xRg = Application.InputBox("Please select the data range:", "EDI macro", xTxt, , , , , 8) Set xRg = Application.Union(xRg, ActiveSheet.UsedRange) If xRg Is Nothing Then Exit Sub For Each cell In xRg Call Color_Dependents Next cell End Sub
在Sub Purple_Range（）
更换：
For Each cell In xRg Cell.Select Next cell
有：
For Each cell In xRg Cell.Select Call Color_Dependents Next Cell
第二个macros失败的原因是因为Color_Dependents（）正在更新当前ActiveCell的颜色，而Purple_Range（）正在遍历该范围，而无需更新ActiveCell的位置以使其处于最新状态。
否则，macros工作正常。