过滤特定列并删除具有未来日期的所有数据

Question

我对 VBA/宏很陌生...我希望宏过滤名为“ABC”的列并删除所有未来日期的数据。例如，今天的日期 10/8/2020 哪个宏应该检查并删除所有具有未来日期的数据。示例 在下面的 excel 屏幕宏中，应删除日期为 10\10\2020 的数据，该数据大于今天的日期，并保留日期为 10\04\2020 的数据，该数据已过去。

我尝试了多种编码方式，但都没有成功。以下是我尝试过的最新代码，但失败了。

 Private Sub CommandButton5_Click()

Dim row As Long
Dim lastrow As Long
Dim mindate As Date
Dim maxdate As Date
Dim st As Worksheet

'Column Name 
cons = "Vessel Estimated Time of Departure"
st = Worksheet("POL")

mindate = CDate(Cells(1, 10))
maxdate = CDate(Cells(1, 12))

ActiveWorkbook.Worksheets("POL").lastrow = Cells(Rows.Count, "cons").End(xlUp).row
row = 1 'Set here the starting row for checking transaction dates
Do While row <= lastrow
transdate = CDate(Cells(row, 3))
    If transdate < mindate Or transdate > maxdate Then
        Rows(row).EntireRow.Delete
    Else
        row = row + 1
    End If
Loop

End Sub

我想要的只是“船舶预计出发时间”列上的宏过滤器，并默认从当前系统日期中删除所有具有未来日期的数据。

Answer 1

类似，但此代码会根据字符串检查找到的列的每个单元格值。

如果有一个日期大于今天的日期，它将用“x”标记单元格

函数 deltR 将删除在找到的列上包含 x 标记的任何单元格的 ENTIREROW。

试一试，如果您有任何问题，请告诉我，

请看下面的脚本：

Option Explicit

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 tDate As String




Sub foo()
    
    'setting wb as thisworkbook
    Set wb = ThisWorkbook
    
    'row 1 assigned into fRng(find range) object
    Set fRng = wb.Sheets("POL").Rows(1).Find(what:="Vessel Estimated Time of Departure", LookIn:=xlValues, lookat:=xlWhole)
    
    'gets fRng range object, and assigns its column property value into fCol variable
    fCol = fRng.Column
    

    'finding the last row for column 1, make sure you select a col that covers the whole data set, based on last row
    tRow = wb.Sheets("POL").Cells(Rows.Count, 1).End(xlUp).Row

    'assigning range based on col index based on str search(fCol) + total row count (tRow) in sRng range object
    'sRng range object is being used to search for dates above todays date (DATE())
    With wb.Sheets("POL")
    
        Set sRng = .Range(.Cells(2, fCol), .Cells(tRow, fCol))
    
    End With
    
    'obtains current date and formats into mmddyyyy format
    tDate = Format(Date, "mm/dd/yyyy")
    
    'performs a cell loop value check based on found column above "vessel (...) departure..."
    For Each cel In sRng
    
        If Trim(Format(cel.Value, "mm/dd/yyyy")) > tDate Then
            'marks any date greater than today() date with an "x"
            cel.Value = "x"
        
        Else
        End If
        
    Next cel
    
    Set sRng = Nothing
    
    
    With wb.Sheets("POL")
    
        Set sRng = .Range(.Cells(1, fCol), .Cells(tRow, fCol))
    
    End With
    
    'function deltR will remove any cel in found col with has "x" value, where "x" equals to cells that had date greater than DATE() (today)
    'passing arguments: range (sRng), delete anything marked with "x"
    Call deltR(sRng, "x", 1)


End Sub





Private Sub deltR(ByRef sRng As Range, ByVal aStr As String, ByVal f As Integer)

    '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

    wb.Sheets("POL").AutoFilterMode = False

    Set sRng = Nothing

End Sub