我正在尝试解析 Excel 2007 中的一份报告。它基本上是一份会计费用异常报告。该报告包含带有每种异常类型标题的部分。有些类型的异常会从报告中删除。我使用 Do While 循环来查找每个标题,如果需要删除该部分,我会这样做。如果不需要删除任何内容,则代码可以正常工作,但在删除部分后,我会收到“无法获取 Range 类的 FindNext 属性”错误。这是我的代码:
Sub merge_All_Section_Headers()
' Description:
' The next portion macro will find and format the Tranaction Source rows in the file
' by checking each row in column A for the following text: TRANSA. If a cell
' has this text in it, it is selected and a function called merge_text_cells
' is run, which performs concatenation of each Transaction Source header row and
' deletes the text from the rest of the cells with broken up text.
'
lastRow = ActiveSheet.UsedRange.Rows.Count + 1
Range(lastRow & ":" & lastRow).Delete
ActiveSheet.PageSetup.Orientation = xlLandscape
With ActiveSheet.Range("A:A")
Dim searchString As String
searchString = "TRANSA"
'The following sets stringFound to either true or false based on whether or not
'the searchString (TRANSA) is found or not):
Set stringFound = .Find(searchString, LookIn:=xlValues, lookat:=xlPart)
If Not stringFound Is Nothing Then
firstLocation = stringFound.Address
Do
stringFound.Select
lastFound = stringFound.Address
merge_Text_Cells
If ((InStr(ActiveCell.Text, "CHARGE FILER") = 0) And _
(InStr(ActiveCell.Text, "CREDIT FILER") = 0) And _
(InStr(ActiveCell.Text, "PA MIDNIGHT FINAL") = 0) And _
(InStr(ActiveCell.Text, "BAD DEBT TURNOVER") = 0)) Then
section_Del 'Function that deletes unwanted sections
End If
Range(lastFound).Select
Set stringFound = .FindNext(stringFound)
Loop While Not stringFound Is Nothing And stringFound.Address <> firstLocation
End If
End With
'-----------------------------------------------------------------------------------
'BELOW CONTAINS THE CODE THAT WORKS:
Sub merge_All_Section_Headers()
' Description:
' The next portion macro will find and format the Tranaction Source rows in the file
' by checking each row in column A for the following text: TRANSA. If a cell
' has this text in it, it is selected and a function called merge_text_cells
' is run, which performs concatenation of each Transaction Source header row and deletes
' the text from the rest of the cells with broken up text.
'
lastRow = ActiveSheet.UsedRange.Rows.Count + 1
Range(lastRow & ":" & lastRow).Delete
ActiveSheet.PageSetup.Orientation = xlLandscape
With ActiveSheet.Range("A:A")
Dim searchString As String
Dim arrRangesToDelete(0 To 9) As Range
searchString = "TRANSA"
'The following sets stringFound to either true or false based on whether or not
'the searchString (TRANSA) is found or not):
Set stringFound = .Find(searchString, LookIn:=xlValues, lookat:=xlPart)
If Not stringFound Is Nothing Then
firstLocation = stringFound.Address
counter = 0
Do
stringFound.Select
lastFound = stringFound.Address
merge_Text_Cells
If ((InStr(ActiveCell.Text, "CHARGE FILER") = 0) And _
(InStr(ActiveCell.Text, "CREDIT FILER") = 0) And _
(InStr(ActiveCell.Text, "PA MIDNIGHT FINAL") = 0) And _
(InStr(ActiveCell.Text, "BAD DEBT TURNOVER") = 0)) Then
firstRowOfSection = ActiveCell.Row
lastRowOfSection = (ActiveSheet.Range(ActiveCell.Offset(2, 1).Address).End(xlDown).Row + 2)
Set arrRangesToDelete(counter) = Range(firstRowOfSection & ":" & lastRowOfSection)
counter = counter + 1
End If
Range(lastFound).Select
Set stringFound = .FindNext(stringFound)
Loop While Not stringFound Is Nothing And stringFound.Address <> firstLocation
End If
End With
For i = 0 To counter - 1
arrRangesToDelete(i).Delete
Next i
Range(firstLocation).Select
End Sub
因此,数组可以正常工作并完成工作,而不会破坏任何对象。我还是想尝试一下 Union 方法,看看能否让它发挥作用,这也太酷了!
最佳答案
由于 StrFound
中的范围对象已被破坏,您的代码失败了 - 因此当您去应用时它Is Nothing
Juri 提出的错误处理有几种替代方案(如果您确实使用,应立即重置)
- 使用
Union
将所有要删除的部分添加到一个新范围,然后在循环外一次性删除该范围。我的文章中有一个例子 Using Find and FindNext to efficiently delete any rows that contain specific text - 将删除代码移到
.FindNext
之后,而不是之前,并添加一个简单的测试,以在运行Section_Del
之前查看stringfound
是否存在> 代码
联盟方法
Sub UnionAPp()
Dim c As Range
Dim rng1 As Range
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Set rng1 = c
Do
Set c = .FindNext(c)
Set rng1 = Union(rng1, c)
Loop While c.Address <> firstaddress
End If
MsgBox "Your working range is " & rng1.Address
End With
End Sub
因此,您可以修改 FindNext
的标准 Excel 帮助
标准
Sub TestInit()
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
新
Sub TestA()
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
If Not c Is Nothing Then c.Clear
'your code: If Not StrFound Is Nothing Then Call Section_Del
Loop While Not c Is Nothing
End If
End With
End Sub
关于excel - 无法获取范围类错误的 findnext 属性,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/13326692/