Excel VBA过滤器，删除数据&；更新

有人能帮我写代码吗？我离我要做的事情还不到一百万英里，但我现在已经走到了死胡同。我没有编程经验&我不是VBA专家，所以我所做的可能没有意义，或者看起来很傻；请容忍我的学习

我想做的是能够：

筛选工作表“主控”中的H列，以选择日期之前的日期 我将在“B9”范围内输入

删除筛选的行

转到工作表“更新”

从A:18动态复制到最后一列和最后一行

粘贴工作表“master”最后一行中的所有内容

我遇到的问题是日期过滤器不工作

Sub AUTODATE()

Dim dDate As Date
Dim dbDate As Double
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
dbDate = DateSerial(Year(dbDate), Month(dbDate), Day(dbDate) + 1)
Application.ScreenUpdating = False
Sheets("master").Select

If IsDate(Range("B9")) Then

dbDate = Range("B9")
dbDate = DateSerial(Year(dbDate), Month(dbDate), Day(dbDate)) + _
 TimeSerial(Hour(dbDate), Minute(dbDate), Second(dbDate))
        Range("H11").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AutoFilter
        Range("$11:$11").AutoFilter Field:=8, Criteria1:=">" & dbDate
        Range("$12:12").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.SpecialCells _
        (xlCellTypeVisible).EntireRow.Delete
            Range("A11").Select
            On Error Resume Next
            ActiveSheet.ShowAllData
               Sheets("update").Select
               ActiveSheet.ShowAllData
               Range("$18:$18").Select
               Range(Selection, Selection.End(xlDown)).Select
               Selection.Copy
           Sheets("master").Select
           Range("A" & lastRow).Select
           Selection.PasteSpecial
    End If
  Application.ScreenUpdating = False

End Sub

---

底部的代码有点凌乱，我通常会把一些东西推到一个单独的函数（例如查找最后一个单元格）

---

要求：

过滤工作表

master

中的H列，以选择位于同一工作表

B9

删除筛选行

从工作表

update

范围

A:18

动态复制到最后一列和最后一行

从图纸最后一行的上一点开始粘贴范围+1

master

假设：（与发布的代码一致）：

表

master

中的数据范围从

A11开始，数据范围第8列中的所有单元格都具有相同的
NumberFormat

工作表

update

中的数据范围从

A18开始

两张表中的数据范围都是连续的（即中间没有空行或空列）

数据副本包括公式和格式

本守则：

建议阅读以下页面，以便更深入地了解所使用的资源：

,

,

,

我还对您的代码进行了审查，见下文（仅包括带有注释的行）：

---

你期望今天是什么日子？您没有为其设置任何值，因此它将为0，并且您没有使用日期变量dDateTry此可选范围（$11:$11”）。自动筛选字段：=8，准则1:=“>”&CLng（dbDate），运算符：=xlAnd，准则2:=“请注意，您假设如果

自动筛选

为

开启

则

过滤行程

为范围

过滤行程

，这不是一个好的假设，您应该清除

AutoFilter

，并将其设置为

rFilterRange

…True-没有任何东西会阻止另一个应用了过滤器的范围，代码只会假定它是正确的范围。我将更新我的代码。在EEM建议的更新之后，我现在意识到-如果过滤器没有返回任何行，那么

rFilterRange.Offset（1）.Resize（rFilterRange.rows.Count-1）.SpecialCells（xlCellTypeVisible）.EntireRow.Delete Shift:=xlUp

将给出错误1004-找不到任何单元格。

Sub AutoDate()

    Dim lastRow As Long
    Dim lastUpdateRow As Long
    Dim wrksht As Worksheet
    Dim rFilterRange As Range

    Set wrksht = ThisWorkbook.Worksheets("master")

    'Any statement that starts with a '.' applies to wrksht (With... End With)
    With wrksht
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row

        'The range to be filtered - currently columns A:J (columns 1 - 10)
        Set rFilterRange = .Range(.Cells(11, 1), .Cells(lastRow, 10))

        'Turn off the autofilter if it's already on.
        If .AutoFilterMode Then
              wrksht.AutoFilterMode = False
        End If
        'Apply filter to correct range.
        rFilterRange.AutoFilter

        If IsDate(.Range("B9")) Then
            'Apply filter.
            rFilterRange.AutoFilter Field:=8, Criteria1:=">" & .Range("B9")
            If .FilterMode Then
                'Resize to ignore header row & delete visible rows.
                rFilterRange.Offset(1).Resize(rFilterRange.Rows.Count - 1) _
                    .SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
                .ShowAllData
            End If

            'Find new last row.
            lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            Set rFilterRange = .Range(.Cells(11, 1), .Cells(lastRow, 10))

            lastUpdateRow = ThisWorkbook.Worksheets("Update").Cells(Rows.Count, "A").End(xlUp).Row
            rFilterRange.Offset(1).Resize(rFilterRange.Rows.Count - 1).Copy _
                Destination:=ThisWorkbook.Worksheets("Update").Cells(lastUpdateRow, 1)

        End If
    End With

End Sub

Option Explicit

Sub Rng_AutoFilter_Delete_And_Paste()
Dim WshMaster As Worksheet, WshUpdate As Worksheet
Dim rMaster As Range, rUpdate As Range
Dim dDate As Date
Dim rTmp As Range

    Rem Application Settings - OFF
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Rem Set Worksheet Object - End Procedure If any of them is not present
    With ThisWorkbook
        On Error GoTo ExitTkn
        Set WshMaster = .Sheets("master")
        Set WshUpdate = .Sheets("update")
        On Error GoTo 0
    End With

    If IsDate(WshMaster.Range("B9")) Then

        Rem Cleared Records in Wsh Master
        With WshMaster
            Rem Set Date to Filter By
            dDate = .Range("B9")

            Rem Set Data Ramge in Wsh Master
            'Assumes range start at `A11` and it's continuous (i.e. no blank rows nor blank columns in between)
            Set rMaster = .Range("A11").CurrentRegion

            Rem Set AutoFilter
            'Use the `AutoFilter` property instead of the `AutoFilterMode` property
            If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
            rMaster.AutoFilter
        End With

        With rMaster
            Rem Filter and Delete Records in Wsh Master
            'Uses the `NumberFormat` to build the Filter Criteria
            'Assumes all cells in has same `NumberFormat`
            .AutoFilter Field:=8, Criteria1:=">" & Format(dDate, .Cells(2, 8).NumberFormat)
            'Sets a Temp Range to grab the Filter results
            On Error Resume Next
            Set rTmp = .Offset(1).Resize(-1 + .Rows.Count).Columns(8).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            'If Temp Range is `Nothing` then there is `Nothing` to delete
            If Not (rTmp Is Nothing) Then rTmp.EntireRow.Delete
            .Worksheet.ShowAllData
        End With

        Rem Set Data Range in Wsh Update
        With WshUpdate

            Rem Set Data Range in Wsh Update
            'Assumes range start at `A18` and it's continuous (i.e. no blank rows nor blank columns in between)
            Set rUpdate = .Range("A18").CurrentRegion

            Rem Set AutoFilter
            If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
            rUpdate.AutoFilter
        End With

        Rem Paste Records from Wsh Update into Wsh Master
        rUpdate.Copy
        'In line with code posted this assumes OP wants to copy the data as it is (i.e. including formulas & format)
        rMaster.Offset(rMaster.Rows.Count).Resize(1, 1).PasteSpecial
        Application.CutCopyMode = False
        Application.Goto WshMaster.Cells(1), 1

    End If

ExitTkn:
    Rem Application Settings - ON
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub

'lastRow variable is not declared.
'Suggest to always have Option Explicit at the begining of the module
'To do it goto Main Menu \ Options \ Tab: Editor \ Check: Require Variable Declaration
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1  'This is done too early as it will change after deletion of filtered rows

dbDate = DateSerial(Year(dbDate), Month(dbDate), Day(dbDate) + 1)   'Have no purpose as no value have been assigned to the variable as yet

Application.ScreenUpdating = False  'this should be done at the beginning

Sheets("master").Select 'should be qualified

dbDate = DateSerial(Year(dbDate), Month(dbDate), Day(dbDate)) + _
    TimeSerial(Hour(dbDate), Minute(dbDate), Second(dbDate))    'This line achieves nothing.

Range("H11").Select 'Select should be avoided, instead work with objects

Selection.AutoFilter    'Sould check first is the AutoFilter is ON

Range("$11:$11").AutoFilter Field:=8, Criteria1:=">" & dbDate   'Should filter the entire range

On Error Resume Next    'On error should be used for specific purposes and cleared after with On Error Goto 0

Selection.PasteSpecial   'After paste the Clipboard must be cleared with Application.CutCopyMode = False