无法绕过对象未设置异常错误

Question

我在一个僵局计算如何捕获这个空范围变量异常。

我正试图扫描一行标题以从下面的几行恢复数据，excel数据表可能有多个"页面";在下一页有一个新的标题和日期如果碰巧有数据要填充，这可以扩展到许多页。

我的循环似乎在第二次执行时中断，因为find函数无法找到具有所需标题的其他行。我的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 varriable or with block varriable 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