Сравните диапазоны от одного листа до другого на основе фильтра даты - PullRequest
0 голосов
/ 27 марта 2019

У меня есть код ниже для сравнения двух листов на основе фильтров даты.Если уникальное значение меньше указанной даты, записи будут удалены в sheet1, а уникальные значения выше указанной даты будут добавлены в строки в sheet1 из sheet2.

Мне бы хотелось, чтобы кто-то объяснил приведенный ниже код:

Option Explicit

Sub Operation()
    Dim Sheet1 As Excel.Worksheet
    Set Sheet1 = ThisWorkbook.Sheets("Sheet1")

    Dim Sheet2 As Excel.Worksheet
    Set Sheet2 = ThisWorkbook.Sheets("Sheet2")

    Dim SpdDate As Date
    SpdDate = DateSerial(2019, 3, 25)    '// DateValue("March 25,2019")

    DeleteOldTasks Sheet1, SpdDate, Sheet2
    InsertNewTasks Sheet2, Sheet1
End Sub

Private Sub DeleteOldTasks(ByRef Target As Excel.Worksheet, ByVal dt As Date, ByRef Source As Excel.Worksheet)
    Dim LastRow As Long
    LastRow = Target.Cells(Target.Rows.Count, 2).End(xlUp).Row

    Dim i As Long
    For i = LastRow To 2 Step -1
        Dim rng As Excel.Range
        Set rng = Target.Range("B" & i & ":C" & i)

        If (rng.Cells(2) < dt) Then
            If Not (TaskDateExist(Source, rng)) Then
                rng.Cells(2).EntireRow.Delete
            End If
        End If
    Next
End Sub

Private Function TaskDateExist(ByRef Source As Excel.Worksheet, ByRef rng As Excel.Range)
    Dim LastRow As Long
    LastRow = Source.Cells(Source.Rows.Count, 2).End(xlUp).Row

    Dim i As Long
    For i = 2 To LastRow
        Dim lookupRng As Excel.Range
        Set lookupRng = Source.Range("B" & i & ":C" & i)

        If ((rng.Cells(1).Value = lookupRng.Cells(1).Value) And _
           (rng.Cells(2).Value = lookupRng.Cells(2).Value)) Then
            TaskDateExist = True
        End If
    Next
End Function
Private Sub InsertNewTasks(ByRef Source As Excel.Worksheet, ByRef Target As Excel.Worksheet)
    Dim LastRow As Long
    LastRow = Target.Cells(Target.Rows.Count, 2).End(xlUp).Row

    Dim LastDate As Date
    LastDate = Target.Range("C" & LastRow)

    Dim RowToInsert As Excel.Range
    Set RowToInsert = Target.Range("A" & LastRow & ":" & "C" & LastRow).Offset(RowOffset:=1)

    LastRow = Source.Cells(Source.Rows.Count, 2).End(xlUp).Row

    Dim i As Long
    For i = 2 To LastRow
        If (Source.Range("C" & i) > LastDate) Then
            RowToInsert.Cells(1) = Source.Range("A" & i)
            RowToInsert.Cells(2) = Source.Range("B" & i)
            RowToInsert.Cells(3) = Source.Range("C" & i)
        End If
    Next
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...