Как фильтровать и удалять строки данных на основе указанной пользователем даты? - PullRequest
1 голос
/ 20 июня 2019

У меня есть данные для фильтрации по дате начала и дате окончания.

Дата начала и окончания имеют свои собственные столбцы в «Содержании главного издателя».Дата начала находится в столбце G, а дата окончания - в столбце H.

Я пытаюсь отфильтровать и удалить строки данных на основе указанного пользователем диапазона дат в поле «Ввод информации».На вкладке указанная пользователем дата начала находится в ячейке C2, а указанная пользователем дата окончания находится в ячейке E2.

Например, если ячейка C2 равна April 1st, 2019, а ячейка E2 равна April 30th, 2019 Я хочу удалить строки данных, которые не находятся между этими датами.

Этот код работает только с датой окончания.Там написано, что клетки не найдены.

Public Sub DeleteRowsWithAutofilterDates()

    Dim wksData As Worksheet
    Dim lngLastRow As Long
    Dim rngData As Range
    Dim StartDate As Range
    Dim EndDate As Range

    'Set references up-front
    Set wksData = ThisWorkbook.Worksheets("Master Publisher Content")
    Set StartDate = ThisWorkbook.Worksheets("Enter Info").Range("C2")
    Set EndDate = ThisWorkbook.Worksheets("Enter Info").Range("E2")

    'Identify the last row and use that info to set up the Range
    With wksData
        lngLastRow = .Range("G" & .Rows.Count).End(xlUp).Row
        Set rngData = .Range("G2:G" & lngLastRow)
    End With

    '------------------------------------------------------------
    Application.DisplayAlerts = False
    With rngData
        'Apply the Autofilter method to the first column of
        .AutoFilter Field:=1, Criteria1:="<=EndDate"

        'Delete the visible rows while keeping the header
        .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    End With

    '----------------------------------------------------------------

    Application.DisplayAlerts = True

    'Turn off the AutoFilter
    With wksData
        .AutoFilterMode = False
        If .FilterMode = True Then
            .ShowAllData
        End If
    End With

    'Let the user know the rows have been removed
    MsgBox "Damn son! Rows removed."

End Sub

1 Ответ

0 голосов
/ 21 июня 2019

Вы ищете значение ячейки, относящейся к дате начала и окончания, а не сам диапазон. возьмите Dim StartDate As Range и Dim EndDate As Range и сделайте их Dim StartDate As Date и Dim EndDate As Date.

После этого изменения Set StartDate = ThisWorkbook.Worksheets("Enter Info").Range("C2") до StartDate = ThisWorkbook.Worksheets("Enter Info").cells(2, "C").value А Set EndDate = ThisWorkbook.Worksheets("Enter Info").Range("E2") до EndDate = ThisWorkbook.Worksheets("Enter Info").cells(2, "E").value

Это даст вам значение ячейки вместо ее диапазона.

lngLastRow = .Range("G" & .Rows.Count).End(xlUp).Row Должно быть lngLastRow = .Cells(.Rows.Count, "G").End(xlUp).row

Я не уверен, сколько строк вы пройдете, но на самом деле удаление может быть довольно медленным, если у вас много, так что это очистит строку и затем отсортирует.

    Dim wksData As Worksheet
    Dim lngLastRow As Long
    Dim LastCol As Integer
    Dim StartDate As Date
    Dim EndDate As Date

    Dim tDate As Date
    Dim iter As Long

    Set wksData = ThisWorkbook.Worksheets("Master Publisher Content")

    StartDate = ThisWorkbook.Worksheets("Enter Info").Cells(2, "C").value
    EndDate = ThisWorkbook.Worksheets("Enter Info").Cells(2, "E").value

    With wksData
        lngLastRow = .Cells(.Rows.Count, "G").End(xlUp).row

        For iter = 2 To lngLastRow
            if .Cells(iter, "G").value = "" or isnull(.Cells(iter, "G").value) then
                .Rows(iter) = ""
            else
                tDate = .Cells(iter, "G").value

                If tDate < StartDate Or tDate > EndDate Then
                    .Rows(iter) = ""
                End If
            end if
        Next
        LastCol = .Cells.Find(What:="*", after:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
        .Range(Cells(1, 1), Cells(lngLastRow, LastCol)).Sort key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...