我在Worksheet_Change事件中发现了Excel / VBA中的问题。我需要将Target.Dependents分配给一个Range，但如果它没有依赖，则会出现错误。我试过测试Target.Dependents.Cells.Count但是没有用。任何想法？
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 OR Target.Dependents.Cells.Count = 0 Then Exit Sub
Dim TestRange As Range
Set TestRange = Target.Dependents
我也试过“Target.Dependents Is Nothing”。
答案 0 :(得分：10)
简短的回答，没有办法在不引发错误的情况下测试家属，因为如果访问属性本身设置为引发错误且没有任何错误。我不喜欢这个设计，但没有办法在没有压制错误的情况下阻止它。 AFAIK这是你能用它做的最好的事情。
Sub Example()
Dim rng As Excel.Range
Set rng = Excel.Selection
If HasDependents(rng) Then
MsgBox rng.Dependents.Count & " dependancies found."
Else
MsgBox "No dependancies found."
End If
End Sub
Public Function HasDependents(ByVal target As Excel.Range) As Boolean
On Error Resume Next
HasDependents = target.Dependents.Count
End Function
说明，如果没有依赖项，则会引发错误并且HasDependents的值与默认类型（默认值）保持不变，因此返回false。如果是依赖项，则计数值永远不会为零。所有非零整数都转换为true，因此当count被指定为返回值时，返回true。它与你已经使用的非常接近。
答案 1 :(得分：1)
这是我找到的唯一方法，但我希望有一个更好的解决方案：
On Error Resume Next
Dim TestRange As Range
Set TestRange = Target.Dependents
If TestRange.HasFormula And Err.Number = 0 Then ...
答案 2 :(得分：0)
发现于：http://www.xtremevbtalk.com/t126236.html
'Returns a Collection of all Precedents or Dependents found in the Formula of the Cell argument
'Arguments : 'rngCell' = the Cell to evaluate
' : 'blnPrecedents' = 'TRUE' to list Precedents, 'FALSE' to list Dependents
'Dependencies : 'Get_LinksFromFormula' function
'Limitations : does not detect dependencies in other Workbooks
'Written : 08-Dec-2003 by member Timbo @ visualbasicforum.com
Function Get_LinksCell(rngCell As Range, blnPrecedents As Boolean) As Collection
Dim rngTemp As Range
Dim colLinksExt As Collection, colLinks As New Collection
Dim lngArrow As Long, lngLink As Long
Dim lngErrorArrow As Long
Dim strFormula As String, strAddress As String
Dim varLink
On Error GoTo ErrorH
'check parameters
Select Case False
Case rngCell.Cells.Count = 1: GoTo Finish
Case rngCell.HasFormula: GoTo Finish
End Select
Application.ScreenUpdating = False
With rngCell
.Parent.ClearArrows
If blnPrecedents Then
.ShowPrecedents
Else: .ShowDependents
End If
strFormula = .Formula
'return a collection object of Links to other Workbooks
If blnPrecedents Then _
Set colLinksExt = Get_LinksFromFormula(rngCell)
LoopArrows_Begin:
Do 'loop all Precedent/Dependent Arrows on the sheet
lngArrow = lngArrow + 1
lngLink = 1
Do
Set rngTemp = .NavigateArrow(blnPrecedents, lngArrow, lngLink)
If Not rngTemp Is Nothing Then
strAddress = rngTemp.Address(External:=True)
colLinks.Add strAddress, strAddress
End If
lngLink = lngLink + 1
Loop
Loop
LoopArrows_End:
If blnPrecedents Then
.ShowPrecedents True
Else: .ShowDependents True
End If
End With
If blnPrecedents Then 'add the external Link Precedents
For Each varLink In colLinksExt
colLinks.Add varLink, varLink
Next varLink
End If
Finish:
On Error Resume Next
'oh, one of the arrows points to the host cell as well!
colLinks.Remove rngCell.Address(External:=True)
If Not colLinks Is Nothing Then Set Get_LinksCell = colLinks
Set colLinks = Nothing
Set colLinksExt = Nothing
Set rngTemp = Nothing
Application.ScreenUpdating = True
Exit Function
ErrorH:
'error while calling 'NavigateArrow' method
If Err.Number = 1004 Then
'resume after 1st and 2nd error to process both same-sheet
' and external Precedents/Dependents
If Not lngErrorArrow > 2 Then
lngErrorArrow = lngErrorArrow + 1
Resume LoopArrows_Begin
End If
End If
'prevent perpetual loop
If lngErrorArrow > 3 Then Resume Finish
lngErrorArrow = lngErrorArrow + 1
Resume LoopArrows_End
End Function
'Returns a Collection of Range addresses for every Worksheet Link to another Workbook
' used in the formula argument
'Arguments: 'rngCellWithLinks' = the Cell Range containing the formula Link
'Written : 08-Dec-2003 by member Timbo @ visualbasicforum.com
Function Get_LinksFromFormula(rngCellWithLinks As Range)
Dim colReturn As New Collection
Dim lngStartChr As Long, lngEndChr As Long
Dim strFormulaTemp As String, strFilenameTemp As String, strAddress As String
Dim varLink
On Error GoTo ErrorH
'check parameters
Select Case False
Case rngCellWithLinks.Cells.Count = 1: GoTo Finish
Case rngCellWithLinks.HasFormula: GoTo Finish
End Select
strFormulaTemp = rngCellWithLinks.Formula
'determine if formula contains references to another Workbook
lngStartChr = Len(strFormulaTemp)
strFormulaTemp = Replace(strFormulaTemp, "[", "")
strFormulaTemp = Replace(strFormulaTemp, "]", "'")
'lngEndChr = Len(strFormulaTemp)
If lngStartChr = lngEndChr Then GoTo Finish
'build a collection object of links to other workbooks
For Each varLink In rngCellWithLinks.Parent.Parent.LinkSources(xlExcelLinks)
lngStartChr = InStr(1, strFormulaTemp, varLink)
If Not lngStartChr = 0 Then
lngEndChr = 1
strAddress = Mid(strFormulaTemp, lngStartChr + Len(varLink), lngEndChr)
On Error Resume Next
'add characters to the address string until a valid Range address is formed
Do Until TypeName(Range(strAddress)) = "Range"
strAddress = Mid(strFormulaTemp, lngStartChr + Len(varLink), lngEndChr)
lngEndChr = lngEndChr + 1
Loop
'continue adding to the address string until it no longer qualifies as a Range
If Not (lngStartChr + Len(varLink) + lngEndChr) > Len(strFormulaTemp) Then
Do Until Not IsNumeric(Right(strAddress, 1))
strAddress = Mid(strFormulaTemp, lngStartChr + Len(varLink), lngEndChr)
lngEndChr = lngEndChr + 1
Loop
'remove the trailing character
strAddress = Left(strAddress, Len(strAddress) - 1)
End If
On Error GoTo ErrorH
strFilenameTemp = rngCellWithLinks.Formula
'locate append filename to Range address
lngStartChr = InStr(lngStartChr, strFilenameTemp, "[")
lngEndChr = InStr(lngStartChr, strFilenameTemp, "]")
strAddress = Mid(strFilenameTemp, lngStartChr, lngEndChr - lngStartChr + 1) & strAddress
colReturn.Add strAddress, strAddress
End If
Next varLink
Set Get_LinksFromFormula = colReturn
Finish:
On Error Resume Next
Set colReturn = Nothing
Exit Function
ErrorH:
Resume Finish
End Function