无法获取范围类错误的findnext属性
我试图parsingExcel 2007中的一个报告。它基本上是一个会计收费例外的报告。 报告中有每个types的例外都有一个标题的部分。 从报告中删除了一些例外情况。 我正在使用一个Do While循环来查找每个头，如果该部分需要删除，我已经这样做了。 如果什么都不需要删除的代码工作正常，但正确后删除部分我得到一个“无法获取范围类的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 所以，数组可以工作并完成工作，而不会破坏任何对象。 我仍然想尝试联盟的方法，看看我能否得到它的工作，这也会很酷！
你的代码在StrFound的范围对象被破坏了，所以当你去申请的时候它Is Nothing
有几个替代的error handlingbuild议不朱Juri（如果你使用你应该立即重置）
- 将所有要删除的部分添加到
Union的新范围，然后在循环之外单次删除此范围。 我在我的文章中有一个例子，在我的文章使用查找和FindNext有效地删除任何包含特定文本的行 - 将您的删除代码
.FindNext之后，而不是之前，并添加一个简单的testing，以查看在运行您的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
如果所有的事件都被删除， Findnext应该给出一个错误。
一条线
On Error Goto ExitLoop
应该在添加之前添加Set stringFound = .FindNext(stringFound) 。
一条线
ExitLoop:
应在Loop While...后添加Loop While...