Используйте фильтр на основе даты / времени (24-часовой формат), удаляйте целые строки - PullRequest
Новая
       10

Используйте фильтр на основе даты / времени (24-часовой формат), удаляйте целые строки

0 голосов
/ 24 сентября 2018

Я пытался найти этот сайт, чтобы найти Нечто, с помощью которого я мог работать, я нашел что-то, но не знаю, как это не сработало для меня.

У меня есть файл с большим количеством данных, который содержит дату и время (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
...