Excel VBA 根據條件添加行，不滿足條件時停止失敗

Question

全部 -

下面的此宏將包含特定條件的所有行添加到工作簿中的另一個工作表。

我唯一的問題是，如果沒有任何行包含它失敗的標准。 有沒有辦法阻止它失敗並且在沒有找到標准的情況下不添加任何內容？

Sub Test()

Dim rData As Range

Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("Test")
    .AutoFilterMode = False
   .Range("A1").CurrentRegion.AutoFilter Field:=21, Criteria1:="Yes"
   With .AutoFilter.Range
        On Error Resume Next
        Set rData = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not rData Is Nothing Then
            Intersect(rData, .Range("A:U")).Copy ThisWorkbook.Worksheets("Test").Range("A" & Rows.Count).End(xlUp)(2)
        End If
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True

End Sub

Answer 1

為什么不嘗試處理錯誤。 在子例程開始后添加On Error GoTo <Label>語句，並在子例程末尾提供一個空的 Labeled 塊。 您可以更改錯誤處理行為以使其更有意義。 您可以在此處獲取有關On Error語句的更多信息。 https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/on-error-statement#:~:text=On%20Error%20GoTo%200%20disables,when%20a %20procedure%20is%20exited 。

代碼看起來像這樣。

Sub Test()
On Error GoTo END_OF_EXECUTION
    Dim rData As Range
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Worksheets("Test")
        .AutoFilterMode = False
        .Range("A1").CurrentRegion.AutoFilter Field:=21, Criteria1:="Yes"
        With .AutoFilter.Range
            On Error Resume Next
            Set rData = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rData Is Nothing Then
                Intersect(rData, .Range("A:U")).Copy ThisWorkbook.Worksheets("Test").Range("A" & Rows.Count).End(xlUp)(2)
            End If
        End With
        .AutoFilterMode = False
    End With
    
    Application.ScreenUpdating = True
END_OF_EXECUTION:
    MsgBox("No row found", , "Error")
End Sub