Question

我使用标准的财务单元格格式，其中输入为蓝色，引用任何外表的单元格为绿色，其他所有内容均为黑色。

一切都很好 - 我有能力开发基本上做GoTo - ＆gt;的宏。常数 - ＆gt;数字和GoTo - ＆gt;公式然后在公式文本中查找“！”符号

然而，有没有办法选择并突出显示（例如，紫色）所有在表格外使用的单元格，无论它们是作为常量或公式输入还是原始表单上的任何内容？

ie：我希望能够通过宏快速查找和识别任何在表外使用的单元格。我擅长制作宏，但是不能想出任何可以实现这一目标的功能。任何人都可以给我一个暗示让我开始朝着正确的方向前进吗？

编辑：到目前为止我所拥有的：

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

另一种可能性，但第二个宏未成功应用范围内的第一个:(：

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

在Sub Purple_Range（）

中

替换：

For Each cell In xRg
    Cell.Select 
Next cell

使用：

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

第二个宏失败的原因是因为Color_Dependents（）正在更新当前ActiveCell的颜色，而Purple_Range（）在范围内循环而没有更新ActiveCell的位置以使其成为当前。

否则宏工作正常。

Excel宏 - 查找在表格外使用的单元格

1 个答案: