加快Excel表单附属关系search
我已经使用“ShowDependents”和“NavigateArrow”VBA方法合并了表外依赖关系search。 一切运作良好，但它是痛苦的缓慢（对于大量的家属）。 有替代方法，加快它的方法吗？ 我试过禁用ScreenUpdating，但是这并没有加速太多。 这是我的代码是基于： http : //www.technicana.com/vba-for-checking-dependencies-on-otherother-sheet
考虑下面这个函数，如果你传递的单元格直接依赖于不同的表单，则返回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
为了testing它，我将testing子链接到Sheet1上的一个命令button。
在A2中，input公式= A1 + 1 ，Sheet1上没有其他公式。
在Sheet2上，我input了公式=Sheet1!A2 。
回到Sheet1上，如果我selectA2并调用它，它几乎立即popup“True”。 但是，如果我selectA1并调用sub，它将返回“False” – 但只有延迟几秒钟后。
为了debugging它，我在i = i + 1之前把一个Debug.Print i放在循环中。 立即窗口，再次运行后，看起来像：
32764 32765 32766 32767
奇怪的！！！！！ 我完全被困住了，直到我把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，你应该检查，当你正在导航箭头，你还没有回到起点。 以下似乎几乎立即在所有情况下工作，虽然我没有testing它非常：
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)
添加一些这样的检查在你链接的子应该有很大的不同。