嘗試通過vba刪除標題，但得到運行時錯誤91

Question

我得到運行時錯誤91「對象變量或塊變量未設置」與這行代碼。困擾我的是有時候它運行的很好，而其他的它只是給了我錯誤。當我搜尋那個錯誤時，一切似乎都已到位。我試圖刪除重複標題和由零填充的行的行。任何人都可以用它找到問題嗎？

Sub RemoveHeaders() 
Const HdrTextOne As String = "*Station*" 
Const HdrTextTwo As String = "*Export File For Future Analysis*" 
Const HdrTextThree As String = "*0*" 
Const HdrKeepRowOne As Long = 3 
Const HdrKeepRowTwo As Long = 1 
Const HdrKeepRowThree As Long = 19 
Dim c As Range 
Dim lr As Long 
Dim ws As Worksheet 

Set ws = ThisWorkbook.Sheets("Data") 

Application.ScreenUpdating = False 
lr = Range("B" & Rows.Count).End(xlUp).Row 
With Range("B" & HdrKeepRowOne & ":B" & lr) 
    Set c = .Find(HdrTextOne, LookIn:=xlValues, SearchDirection:=xlNext) 
    If Not c Is Nothing And c.Row <> HdrKeepRowOne Then 
     Do 
      c.Resize(5).EntireRow.Delete 
      Set c = .Find(HdrTextOne, LookIn:=xlValues, SearchDirection:=xlNext) 
     Loop While Not c Is Nothing And c.Row <> HdrKeepRowOne 
    End If 
End With 

lr = Range("B" & Rows.Count).End(xlUp).Row 
With Range("B" & HdrKeepRowTwo & ":B" & lr) 
    Set c = .Find(HdrTextTwo, LookIn:=xlValues, SearchDirection:=xlNext) 
    If Not c Is Nothing And c.Row <> HdrKeepRowTwo Then 
     Do 
      c.Resize(5).EntireRow.Delete 
      Set c = .Find(HdrTextTwo, LookIn:=xlValues, SearchDirection:=xlNext) 
     Loop While Not c Is Nothing And c.Row <> HdrKeepRowTwo 
    End If 
End With 

lr = Range("D" & Rows.Count).End(xlUp).Row 
With Range("D" & HdrKeepRowThree & ":D" & lr) 
    Set c = .Find(HdrTextThree, LookIn:=xlValues, SearchDirection:=xlNext) 
    If Not c Is Nothing And c.Row <> HdrKeepRowThree Then 
     Do 
      c.Resize(5).EntireRow.Delete 
      Set c = .Find(HdrTextThree, LookIn:=xlValues, SearchDirection:=xlNext) 
     Loop While Not c Is Nothing And c.Row <> HdrKeepRowThree 
    End If 
End With 
ws.Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
Application.ScreenUpdating = True 

末次

Answer 1

這是與建議的調整（如寫在評論）和幾個更小的改動你的代碼。代碼已經過測試，在我的系統上正常工作。

Option Explicit 

Sub RemoveHeaders() 

Const HdrTextOne As String = "*Station*" 
Const HdrTextTwo As String = "*Export File For Future Analysis*" 
Const HdrTextThree As String = "*0*" 
Const HdrKeepRowOne As Long = 3 
Const HdrKeepRowTwo As Long = 1 
Const HdrKeepRowThree As Long = 19 

Dim c As Range 
Dim lr As Long 
Dim ws As Worksheet 

For Each ws In ThisWorkbook.Worksheets 
    If InStr(1, ws.Name, "Data", vbTextCompare) Then 
     MsgBox "Using the sheet:" & Chr(10) & "'" & ws.Name & "'" 
     Exit For 
    Else 
     MsgBox "Sheet not found." & Chr(10) & "Aborting!" 
     Exit Sub 
    End If 
Next ws 

Application.ScreenUpdating = False 

lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row 

If lr > HdrKeepRowThree Then 
    With ws.Range("B" & HdrKeepRowOne & ":B" & lr) 
     Set c = .Find(HdrTextOne, LookIn:=xlValues, SearchDirection:=xlNext) 
     If Not c Is Nothing And c.Row <> HdrKeepRowOne Then 
      Do 
       c.Resize(5).EntireRow.Delete 
       Set c = .Find(HdrTextOne, LookIn:=xlValues, SearchDirection:=xlNext) 
      Loop While Not c Is Nothing And c.Row <> HdrKeepRowOne 
     End If 
     Set c = Nothing 


     Set c = .Find(HdrTextTwo, LookIn:=xlValues, SearchDirection:=xlNext) 
     If Not c Is Nothing And c.Row <> HdrKeepRowTwo Then 
      Do 
       c.Resize(5).EntireRow.Delete 
       Set c = .Find(HdrTextTwo, LookIn:=xlValues, SearchDirection:=xlNext) 
      Loop While Not c Is Nothing And c.Row <> HdrKeepRowTwo 
     End If 
     Set c = Nothing 
    End With 
End If 

lr = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row 

If lr > HdrKeepRowThree Then 
    With ws.Range("D" & HdrKeepRowThree & ":D" & lr) 
     Set c = .Find(HdrTextThree, LookIn:=xlValues, SearchDirection:=xlNext) 
     If Not c Is Nothing And c.Row <> HdrKeepRowThree Then 
      Do 
       c.Resize(5).EntireRow.Delete 
       Set c = .Find(HdrTextThree, LookIn:=xlValues, SearchDirection:=xlNext) 
      Loop While Not c Is Nothing And c.Row <> HdrKeepRowThree 
     End If 
     Set c = Nothing 
    End With 
End If 

On Error GoTo NoBlanksFound 
ws.Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
On Error GoTo 0 

NoBlanksFound: 
Application.ScreenUpdating = True 

End Sub 

注意，該Find方法不支持通配符如*。如果您希望查找部分字符串，則應將Find更改爲LookAt:=xlPartas stipulated on MSDN。

讓我知道這是否能解決您的問題。