Question

我已经使用＆＃34; ShowDependents＆＃34;成立了表外家属搜索。和＆＃34; NavigateArrow＆＃34; VBA方法。一切都运作良好，但它只是痛苦的缓慢（对于大量的家属）。有没有其他方法可以加快速度？我尝试过禁用ScreenUpdating，但这并没有加快速度。这是我的代码基于：http://www.technicana.com/vba-for-checking-dependencies-on-another-sheet

Answer 1

考虑以下函数，如果您传递的单元格直接依赖于不同的工作表，则该函数应返回true：

Function LeadsOut(c As Range) As Boolean
    Application.ScreenUpdating = False
    Dim i As Long, target As Range
    Dim ws As Worksheet

    Set ws = ActiveSheet
    c.ShowDependents

    On Error GoTo return_false
    i = 1
    Do While True
        Set target = c.NavigateArrow(False, i)
        If c.Parent.Name <> target.Parent.Name Then
            ws.Select
            ActiveSheet.ClearArrows
            Application.ScreenUpdating = True
            LeadsOut = True
            Exit Function
        End If
        i = i + 1
    Loop
return_false:
    LeadsOut = False
    ActiveSheet.ClearArrows
    Application.ScreenUpdating = True
End Function

Sub test()
    MsgBox LeadsOut(Selection)
End Sub

为了测试它，我将测试子链接到Sheet1上的命令按钮。

在A2中，我输入了公式= A1 + 1，而Sheet1上没有其他公式。

在Sheet2上，我输入了公式=Sheet1!A2。

回到Sheet1，如果我选择A2并调用它，它几乎立即弹出“True”。但是如果我选择A1并调用sub它会返回“False” - 但仅在延迟几秒之后。

为了调试它，我在Debug.Print i之前将i = i + 1放在循环中。立即窗口，再次运行后，看起来像：

奇怪!!!!! 在我用<{p}}取代Debug.Print i之前，我完全被难倒了

Debug.Print target.Address(External:=True)

导致输出结果如下：

[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1

NavigateArrow(False,i)回到起源小区，一旦我超过了家属的数量就停留在那里！这似乎没有记录，并且非常烦人。您链接的代码是由未发现此代码的人编写的。作为一个kludge，你应该检查当你导航箭头时你还没有回到起点。在所有情况下，以下似乎几乎立即起作用，尽管我没有对它进行过多次测试：

Function LeadsOut(c As Range) As Boolean
    Application.ScreenUpdating = False
    Dim i As Long, target As Range
    Dim ws As Worksheet

    Set ws = ActiveSheet
    c.ShowDependents

    On Error GoTo return_false
    i = 1
    Do While True
        Set target = c.NavigateArrow(False, i)
        If target.Address(External:=True) = c.Address(External:=True) Then
            GoTo return_false
        End If
        If c.Parent.Name <> target.Parent.Name Then
            ws.Select
            ActiveSheet.ClearArrows
            Application.ScreenUpdating = True
            LeadsOut = True
            Exit Function
        End If
        i = i + 1
    Loop
return_false:
    LeadsOut = False
    ActiveSheet.ClearArrows
    Application.ScreenUpdating = True
End Function

关键线是三行开始

If target.Address(External:=True) = c.Address(External:=True)

在您链接的子中添加一些此类检查应该会产生巨大的差异。

加速Excel表外家属搜索

1 个答案: