Excelの範囲にセルがあることをどのようにテストしますか？

Question

Excel/VBAでWorksheet_Changeイベントに問題が見つかりました。私はRangeにTarget.Dependentsを割り当てる必要がありますが、もしそれが扶養家族を持たないなら、それはエラーを引き起こします。私は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に変換されるため、countが戻り値として割り当てられると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