无法解决带有异常的对象未设置错误

Question

我在弄清楚如何捕获这个空范围变量异常时陷入了僵局。

我正在尝试扫描一行标题以从下面几行恢复数据，Excel 数据表可能有多个“页面”，如果恰好有数据填充它，则下一个“页面”上有新的标题和日期这可以扩展到很多页面。

在查找函数无法找到具有所需标题的其他行后，我的循环似乎在第二遍时中断。我的 if 语句无法检测到变量为空，并且我反复收到对象未设置错误。

我尝试了多种方法来调用 null 异常，例如 is empty、is null，都采用了几种不同的语法形式，但仍然没有成功。

预先感谢您的帮助！

Sub testingBreak()
Dim testing As String
Dim starting As String
testing = "testing"
starting = "starting"
Dim productNameRange() As Range
Dim PN2CellAddress As String
Dim rowCount As Integer
rowCount = 0
Dim oldCount As Integer
oldCount = 0
ReDim productNameRange(rowCount)
Dim r As Integer

Set productNameRange(rowCount) = Sheets(starting).Cells.Find( _
    What:="Product Name", LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)

If productNameRange(rowCount) Is Nothing Then
    MsgBox ("Search Error: Header Not found")
Else
    Do While Not IsEmpty(productNameRange(rowCount))   'this is to search for additional rows with the same header name
       oldCount = rowCount
       rowCount = rowCount + 1
       MsgBox rowCount & " & " & oldCount
 
      ReDim Preserve productNameRange(rowCount)
      If IsNull(productNameRange(oldCount)) Then '<<<<this if statement does not catch that the variable was not set :(      <<<<<
          MsgBox "null exception worked"
      Else
          MsgBox productNameRange(oldCount) '<<<<on second loop, I get the error "object variable or with block variable not set"...               <<<<<<
      End If
      Set productNameRange(rowCount) = Sheets(starting).Range(productNameRange(oldCount).Address).FindNext( _
           productNameRange(oldCount)) ' <<<  does not set the next range if there is none
     Loop
     MsgBox rowCount & "Row(s) have been found!"
     For r = 0 To rowCount - 1
         MsgBox productNameRange(r)
     Next r
   End If
End Sub

Answer 1

所以这似乎解决了我的问题。谢谢大家的帮助

Dim f As Variant


Private Function FindAllHeaderRows(val As String, filePath As String) As Collection
    Dim rv As New Collection, g As Range
    Dim addr As String
    Dim wb As Workbook: Set wb = Workbooks.Open(filePath) ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    Set g = ws.Cells.Find(What:=val, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If Not g Is Nothing Then addr = g.Address

    Do Until g Is Nothing
        rv.Add g
        Set g = ws.Cells.FindNext(After:=g)
       If Not g Is Nothing Then
       If g.Address = addr Then Exit Do
       End If
    Loop

    Set FindAllHeaderRows = rv
End Function                                 'working!


Sub testSub1()
Dim FileToOpen As String
FileToOpen = Application.GetOpenFilename(Title:="Select Data file")
   Set rangeCo = FindAllHeaderRows("Product Name", FileToOpen)
For Each f In rangeCo
MsgBox f.Address 'shows address
Next f
MsgBox rangeCo.count  ' shows how many
End Sub

Answer 2

查找标准单元格（

Find

&

FindNext

）

Sub FindCriteriaCells()

    Const wsName As String = "Starting"
    Const Criteria As String = "Product Name"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim rg As Range: Set rg = ws.UsedRange
    Dim fCell As Range: Set fCell = rg.Find(What:=Criteria, _
        After:=rg.Cells(rg.Rows.Count, rg.Columns.Count), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True)
    
    Dim Headers() As Range
    Dim n As Long
    
    If Not fCell Is Nothing Then
        Dim FirstAddress As String: FirstAddress = fCell.Address
        Do
            ReDim Preserve Headers(0 To n)
            Set Headers(n) = fCell
            n = n + 1
            Set fCell = rg.FindNext(After:=fCell)
        Loop Until fCell.Address = FirstAddress
    End If
    
    Dim Msg As String
    
    If n > 0 Then
        Msg = "The header '" & Criteria & "' was found in " _
            & n & " cell(s):" & vbLf
        For n = 0 To n - 1
            Msg = Msg & vbLf & Headers(n).Address(0, 0)
        Next n
        MsgBox Msg, vbInformation
    Else
        Msg = "The header '" & Criteria & "' was not found."
        MsgBox Msg, vbExclamation
    End If
 
End Sub