使用基于日期/时间的过滤器(24小时格式),删除整行

时间:2018-09-24 01:40:24

标签: excel vba date time autofilter

我试图搜索该站点,以找到在我可以工作的帮助下找到的东西,但发现了一些东西,但对我来说却没有用。

我有一个包含大量数据的文件,其中包含日期和时间(24小时格式),问题是我想删除小于或等于的行,例如:具有第二个条件的24.09.2018时间小于或等于16:30:00,否则将在输入框中插入任何时间。

我有一些代码,但是无论如何我都没有希望。

Sub LastRowInOneColumn()
    ' deleteFirst_rows Makro
    Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    'Find the last used row in a Column: column A in this example
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "R").End(xlUp).Row
    End With
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*1"
    Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Selection.AutoFill Destination:=Range("S2:S" & LastRow)
    Range("S2:S" & LastRow).Select
    Selection.Copy
    Range("R2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-x-systime]HH:MM:SS "
    Range("S2:S" & LastRow).ClearContents
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]*1"
    Selection.NumberFormat = "m/d/yyyy"
    Selection.AutoFill Destination:=Range("S2:S" & LastRow)
    Range("S2:S" & LastRow).Select
    Selection.Copy
    Range("Q2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
    Range("S2:S" & LastRow).ClearContents
End Sub

Sub DeleteFromDate()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim LR As Long
    LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    DateR = Application.InputBox("Enter based on date to delete", TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1)
    Cells.AutoFilter Field:=2, Criteria1:=">=" & DateR
    ALR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    If ALR > 2 Then
        Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).Select
        Range("A2:A" & LR).Delete
        Range("A1").Activate
    End If
    Cells.AutoFilter
    MsgBox "Finished deleting rows"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub


Sub DeleteFromDate()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim LR As Long
    LR = ActiveSheet.Range("R" & Rows.Count).End(xlUp).Row
    DateR = Application.InputBox("Enter based on date to delete", TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1)
    ZeitR = Application.InputBox("Enter based on Time to Delete", TitleMsg, FormatDateTime(Time, vbLongTime), Type:=1)
    Cells.AutoFilter Field:=17, Criteria1:="<" & DateR
    Cells.AutoFilter Field:=18, Criteria2:="<" & ZeitR
    ALR = ActiveSheet.Range("R" & Rows.Count).End(xlUp).Row
    If ALR > 2 Then
        Range("A2:R" & LR).SpecialCells(xlCellTypeVisible).Select
        Range("A2:R" & LR).Delete
        Range("A1").Activate
    End If
    Cells.AutoFilter
    MsgBox "Finished deleting rows"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

0 个答案:

没有答案