无法绕过 object not set error with exceptions
Not able to get around object not set error with exceptions
我在弄清楚如何捕获这个 null 范围变量异常时陷入僵局。
我正在尝试扫描一行 header 以从下面的几行中恢复数据，excel 数据表可能有多个“页面”和一个新的 header和下一个“页面”上的日期，如果恰好有数据可以填充它并且这可以扩展到许多页面。
在查找函数无法找到具有所需 header 的其他行后，我的循环似乎在第二次通过时中断。我的 if 语句无法检测到变量为空，我反复收到 object not set 错误。
我尝试了几种调用 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
查找标准单元格（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
所以这似乎解决了我的问题。感谢大家的帮助
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
我在弄清楚如何捕获这个 null 范围变量异常时陷入僵局。
我正在尝试扫描一行 header 以从下面的几行中恢复数据，excel 数据表可能有多个“页面”和一个新的 header和下一个“页面”上的日期，如果恰好有数据可以填充它并且这可以扩展到许多页面。
在查找函数无法找到具有所需 header 的其他行后，我的循环似乎在第二次通过时中断。我的 if 语句无法检测到变量为空，我反复收到 object not set 错误。
我尝试了几种调用 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
查找标准单元格（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
所以这似乎解决了我的问题。感谢大家的帮助
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