你如何testing在Excel中的范围内有单元格?

我在Worksheet_Change事件的Excel / VBA中发现了一个问题。 我需要将Target.Dependents分配给Range,但是如果没有依赖项,则会引发错误。 我试过testingTarget.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是Nothing”。

简单的答案是,没有任何方法可以在不引发错误的情况下testing依赖项,因为如果访问属性本身就会产生错误,并且没有任何错误。 我不喜欢这个devise,但没有办法阻止错误。 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的值与默认types保持不变,这是false,因此返回false。 如果有家属,计数值将永远不会为零。 所有非零整数转换为true,所以当计数被分配为返回值时,返回true。 这很接近你已经使用。

这是我发现的唯一方法,但我更喜欢更好的解决scheme:

 On Error Resume Next Dim TestRange As Range Set TestRange = Target.Dependents If TestRange.HasFormula And Err.Number = 0 Then ... 

如下所示: 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