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

End Sub

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:=xlPart as stipulated on MSDN。

如果这可以解决您的问题，请告诉我。

尝试通过vba删除标头但得到运行时错误91

1 个答案: