如何测试Excel中的Range是否包含单元格？

Question

我在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”。

Answer 1

简短的回答，没有方法来测试依赖项而不会产生错误，因为如果访问属性本身并且没有任何错误，则会将该属性设置为引发错误。我不喜欢这种设计，但没有办法阻止错误。 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，所以当计数被分配为返回值时，返回true。它非常接近你已经使用的东西。

Answer 2

这里是我发现使它工作的唯一途径，但我喜欢一个更好的解决方案：

On Error Resume Next 
Dim TestRange As Range 
Set TestRange = Target.Dependents 

If TestRange.HasFormula And Err.Number = 0 Then ... 

Answer 3

由于上找到：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