Sub макрос_шмакрос()
If ActiveCell.HasFormula = False Then Exit Sub
Application.ScreenUpdating = False
'ActiveSheet.ClearArrows
For Each sh In Worksheets             '100
  If sh.Name <> ActiveSheet.Name Then '101
  sh.Cells.Interior.ColorIndex = xlNone
  End If                              '101
Next sh                               '100
Set rrr = ActiveCell
rrr.ShowPrecedents
a = 1: l = 1
  Do                                  '103
  Application.Goto rrr
  On Error Resume Next
  rrr.NavigateArrow TowardPrecedent:=True, ArrowNumber:=a, LinkNumber:=l
  If ActiveCell.Address(external:=True) = rrr.Address(external:=True) Then Exit Do
    If ActiveCell.Interior.ColorIndex = xlNone Then '104
    ActiveCell.Interior.ColorIndex = 4
    'можно добавить примечание - на какую ячейку влияет
    'можно адрес записать....
    Else                                            '104
    Exit Do
    End If                                          '104
  l = l + 1
  Loop                                '103
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
Beep
End Sub