如何測試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