Question

当我尝试在没有需要排除的DATE（上个月）的情况下运行此代码时，会出现错误，并且说“没有CELLS找到了”＃34;我尝试添加＆＃34;否则msgbox＆＃34;但它没有运作。有人可以帮我如何为我的代码添加另一个条件。谢谢

Sub ExclusionDates()


    Dim sh As Worksheet, ws As Worksheet

    Set sh = Worksheets("Raw Data") 'set the sheet to filter
    Set ws = Worksheets("Exclusion") 'set the sheet to paste
    ws.Range("AD1", ws.Cells(ws.Rows.count, "A").End(xlUp)).clearcontents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one

'    Application.ScreenUpdating = False

    With sh '<--| reference your "copy" sheet
        With .Range("AD1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its columns A:L cells from row 1 down to column A last not empty cell
                       .AutoFilter field:=10, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic

            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
            .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.count, "A").End(xlUp).Offset(0) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
            .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '

        End If

                End With
        .AutoFilterMode = False
    End With

'    Application.ScreenUpdating = True

End Sub

Answer 1

我认为缺陷在于

If Application.WorksheetFunction.Subtotal(103, .Cells) > 1

总是会返回True，因为它会检查在引用范围内有多少单元格可见，这是从A列到AD的某个范围，因此始终至少返回30（列标题的数量）

所以你可能想要使用

If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1

这里是带有正确行的代码和Else以及其他一些评论调整

Option Explicit

Sub ExclusionDates()

    Dim sh As Worksheet, ws As Worksheet

    Set sh = Worksheets("Raw Data") 'set the sheet to filter
    Set ws = Worksheets("Exclusion") 'set the sheet to paste
    ws.Range("AD1", ws.Cells(ws.Rows.count, "A").End(xlUp)).ClearContents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one


    With sh '<--| reference your "copy" sheet
        With .Range("AD1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its columns A:AD cells from row 1 down to column A last not empty cell
            .AutoFilter field:=10, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
            If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then '<--| if any cell on column A filtered other than header (which gets always filtered)
                .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.count, "A").End(xlUp).Offset(0) '<--| copy filtered values to "paste" sheet
                .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete ''<--| delete filtered values rows
            Else
                MsgBox "No Data found"
            End If
        End With
        .AutoFilterMode = False
    End With

End Sub

Answer 2

您可以使用错误处理。将错误GoTo ErrHand置于您希望抛出错误的行之前。

Option Explicit

Sub ExclusionDates()

    Dim sh As Worksheet, ws As Worksheet

    Set sh = Worksheets("Raw Data")              'set the sheet to filter
    Set ws = Worksheets("Exclusion")             'set the sheet to paste
    ws.Range("AD1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).ClearContents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one

    '    Application.ScreenUpdating = False

    With sh                                      '<--| reference your "copy" sheet
        With .Range("AD1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:L cells from row 1 down to column A last not empty cell
            .AutoFilter field:=10, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic

            On Error GoTo ErrHand:
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
                .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
                .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '

            End If

        End With
        .AutoFilterMode = False
    End With

    '    Application.ScreenUpdating = True

    Exit Sub

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "No cells found"
        Err.Clear
    Else
        Debug.Print Err.Description

    End If

End Sub

过滤并转移到另一张纸上＃34;没有发现任何细胞＆＃34;

2 个答案: