为依赖于其他单元格的单元格着色

时间:2019-10-30 05:35:21

标签: excel vba performance

我编写了一个代码,检查是否在其他任何工作表中都引用了单元格值。简单地,它会检查单元格的依赖关系并为其着色。 基本上,我要做的是处理单元格相关性,如果工作表名称不是最初使用的名称,则会为其上色。这是代码

Dim r As Long, c As Long, sh As Worksheet, name As String, rg As Range, chksh As String ' r is row and c is coloumn
Application.ScreenUpdating = False
Application.EnableEvents = False

name = "Main sheet"

Set sh = ThisWorkbook.Sheets(name)
Set rg = sh.Range("A4").CurrentRegion

r = rg.Rows.Count
c = rg.Columns.Count

Dim i As Long, j As Long
i = 1
j = 1
sh.Select

Do While i < r + 1
    j = 1
    Do While j < c + 1
        sh.Cells(i, j).Select
        Selection.ShowDependents
        ActiveCell.NavigateArrow TowardPrecedent:=False, ArrowNumber:=1, _
        LinkNumber:=1
        chksh = ActiveSheet.name
        If chksh <> name Then 'there is a dependent in other sheet

            sh.Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
             End With
        End If
        j = j + 1
    Loop
    i = i + 1
Loop

ActiveSheet.ClearArrows
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

由于.select的使用,时间太长。 请提出一个无需使用select的改进代码,以便眨眼之间即可运行。

1 个答案:

答案 0 :(得分:0)

简体:

Sub Tester()

    Dim sh As Worksheet, rg As Range, c As Range

    Set sh = ThisWorkbook.Sheets("Main sheet")

    Set rg = sh.Range("A4").CurrentRegion

    For Each c In rg.Cells
        c.ShowDependents
        c.NavigateArrow TowardPrecedent:=False, ArrowNumber:=1, LinkNumber:=1
        If ActiveSheet.name <> sh.name Then
            c.Interior.Color = vbRed
        End If
    Next c

    sh.ClearArrows

End Sub