Excelマクロ - オフシートで使用されているセルを見つける

Question

標準財務セルの書式設定を使用します。入力が青で、オフシートを参照するセルは緑で、その他はすべて黒です。

私は基本的にGoTo - >定数 - >数とGoTo - >数式を実行し、その後、 "！"の数式テキスト内を調べるマクロを開発することができました。シンボル。

しかし、オフシートで使用されているすべてのセルを、定数や数式などの元のシートに入力しているかどうかに関係なく、選択してハイライト表示することはできますか？

ie：マクロを使ってオフシートで使用されているセルをすばやく見つけて識別できるようにしたいと考えています。私は一般的にマクロを作るのが得意ですが、これを達成する機能を考えることはできません。誰かが正しい方向に私を始めるためのヒントを教えてくれますか？私がこれまで持っているもの：：

EDIT

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 

別の可能性が、2番目のマクロが正常範囲:(全体で最初のものは適用されません：サブPurple_Rangeで

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 

Answer 1

を（）

は交換してください：

For Each cell In xRg 
    Cell.Select 
Next cell 

Color_Dependentsは（）にするのActiveCellの位置を更新アウトと範囲を循環した）現在のActiveCellとPurple_Range（の色を更新したため、2番目のマクロが失敗した理由があった

For Each cell In xRg 
    Cell.Select 
    Call Color_Dependents 
Next Cell 

：で

それは電流です。

それ以外の場合、マクロは正常に動作していました。