读取/过滤列并删除所有未来日期的数据

Question

我想过滤一个名为“Vessel Estimated Time of Arrival”的列，并删除所有未来日期的数据。

例如，今天的日期 2020 年 11 月 13 日。检查并删除所有未来日期的数据，并保留 2020 年 11 月 13 日之前的所有数据。

此宏执行没有错误，但不会删除 2021 年的数据。

Sub Sort_ETAPOD()
    
    Dim wb As Workbook
    Dim sRng As Range
    Dim fRng As Range
    Dim cel As Range
    Dim tRow As Long
    Dim fCol As Long
    Dim tmDate As String
        
    Set wb = ThisWorkbook
            
    Set fRng = ActiveWorkbook.Worksheets("POD").Rows(1).Find(what:="Vessel Estimated Time of Arrival", LookIn:=xlValues, lookat:=xlWhole)
            
    fCol = fRng.Column
        
    tRow = ActiveWorkbook.Worksheets("POD").Cells(Rows.Count, 1).End(xlUp).Row
        
    With ActiveWorkbook.Worksheets("POD")
        Set sRng = .Range(.Cells(2, fCol), .Cells(tRow, fCol))
    End With
            
    'Date format MM-DD-YYYY
            
    tmDate = Format(Date, "mm/dd/yyyy")
            
    'performs a cell loop value to check for "vessel (...) departure..."
            
    For Each cel In sRng
            
        If Trim(Format(cel.Value, "mm/dd/yyyy")) >= tmDate Then
            'marks any date greater than today() date with an "y"
            cel.Value = "y"
                
        Else
        End If
                
    Next cel
            
    Set sRng = Nothing
            
    With wb.Sheets("POD")
        Set sRng = .Range(.Cells(1, fCol), .Cells(tRow, fCol))
    End With
            
    'function deltR will remove any cel in found col with has "y" value, where "y" equals to cells that had date greater than DATE() (today)
    'passing arguments: range (sRng), delete anything not empty, on col#1 (sRng has only one range = columns("U:U" + tRow)
    Call deltpod(sRng, "y", 1)
        
End Sub
    
Private Sub deltpod(ByRef sRng As Range, ByVal aStr As String, ByVal f As Integer)
    
    Dim wb As Workbook '---This Relates to (Vessal Estimated time of arrival event)----
    
    'this sub procedure looks for a string (aStr) passed in (sRng) range object range, based on col number (f)
    With sRng
        .AutoFilter Field:=f, Criteria1:=aStr
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    
    ActiveWorkbook.Worksheets("POD").AutoFilterMode = False
    
    Set sRng = Nothing
    
End Sub 

Answer 1

这里有一个快速的解决方案来满足您的需求。它应该用作模板，您需要确保正确设置范围并进行一些错误检查以确保它不会倒下。它应该删除今天日期之后的所有行。

Sub test()
Dim rng As Range

Dim todayDate As Date

todayDate = Date

Set rng = Sheet1.UsedRange

rng.AutoFilter Field:=19, Criteria1:= _
        ">" & todayDate, Operator:=xlAnd
        
rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.ShowAllData
End Sub

如果您有任何问题，请告诉我，我会尽力帮助您解决问题。祝你好运！

很公平...我假设您会根据您已经完成的内容修改代码。无论哪种方式，这里有一个方法允许您定义列标题并使用它而不是硬编码：

Sub test()
Dim rng As Range
Dim colNum As Integer
Dim todayDate As Date

todayDate = Date

Set rng = Sheet1.UsedRange
colNum = Application.WorksheetFunction.Match("test", rng.Rows(1), 0)

rng.AutoFilter Field:=colNum, Criteria1:= _
        ">" & todayDate, Operator:=xlAnd
        
rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.ShowAllData
End Sub

请记住，这假设您使用的是 Sheet1 并且您的标题是使用范围的第一行。有更可靠的方法来设置使用的范围，但我会让您自行决定是否更改。此外，不要忘记在列标题搜索周围进行一些错误检查（如果列标题不存在则进行测试）以及在删除周围进行一些错误处理（如果没有未来日期会发生什么）。假设标题总是存在或总是有未来的日期通常是不安全的。

祝你好运！