Question

有人可以请求我的代码帮助，我距离我想做的事情还不到一百万英里，但我现在已经脱离困境并走到了尽头。我没有编程经验和我不是VBA的专家，所以我所做的可能没有意义，或者看起来很傻;我正在学习，请耐心等待。

我想做的是：

过滤表单“master”中的列H以选择日期之前的日期我将在范围“B9”中输入。
删除已过滤的行
转到表“更新”
从A：18动态复制到最后一列＆amp;最后一行
将所有内容粘贴到工作表“master”的最后一行

我遇到的问题是日期的过滤器无法正常工作

$this-get('request')

Answer 1

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

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

Answer 2

<强>要求：

过滤工作表master中的列H，以选择B9
删除过滤后的行
从工作表update范围A:18 动态复制到最后一列＆amp;最后一行
从工作表master的最后一行+ 1 中的上一个点开始粘贴范围

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

工作表master中的数据范围从A11开始，数据范围第8列中的所有单元格都具有相同的NumberFormat
工作表update中的数据范围从A18
两张图中的数据范围是连续的（即没有空白行，中间没有空白列）
数据的复制包括公式＆amp;格式

你的代码：

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

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

Excel Objects，On Error Statement，Range Object (Excel)，Variables & Constants，

Worksheet.AutoFilter Property (Excel)，Worksheet.AutoFilterMode Property (Excel)，

Worksheet Object (Excel)，With Statement

我还对您的代码进行了审核，请参阅下面的（仅包含评论行）：

'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

Excel VBA过滤器，删除数据＆amp;更新

2 个答案: