как объединить / прозрачно отделить данные

Question

У меня есть данные за период с 2019 по 2021 год и с 2016 по 2018. Я хочу объединить данные и номера ключей, чтобы следовать, я думал, что это лучше всего через VBA.Но я не знаю, как это сделать, пока я перемещаю данные с одного листа на этот, и здесь у меня есть собранные данные.Но годы разделены.Мне нужно, чтобы это было так, как показано в строке R - T. Это было бы для меня большой помощью, потому что у меня есть 65 из этих листов.Так что простой VBA очень помог бы!

Заранее спасибо

Я пытался написать VBA.Он добирается туда, но смешивает его в результате

    Sub x()

Dim lngDataColumns As Long
Dim lngDataRows As Long

lngDataColumns = 2
lngDataRows = 20


For t = 1 To lngDataRows

Range("n2").Offset(((t - 1) * lngDataColumns) - 1, 0).Resize(lngDataColumns, 1).Value = _
        Application.Transpose(Range("g24:h24").Offset(t).Value)

Range("o2").Offset(((t - 1) * lngDataColumns) - 1, 0).Resize(lngDataColumns, 1).Value = _
        Application.Transpose(Range("i24:j24").Offset(t).Value)
Next t

End Sub
    Sub y()



Dim lngDataColumns As Long
Dim lngDataRows As Long

lngDataColumns = 3
lngDataRows = 20



Range("p2").Offset(((t - 1) * lngDataColumns) - 1, 0).Resize(lngDataColumns, 1).Value = _
        Application.Transpose(Range("h5").Offset(t).Value)

    End Sub

Answer 1

Вы можете попробовать:

Option Explicit

Sub test()

    Dim LastrowH As Long, Year As Long, i As Long, LastrowR As Long
    Dim Amount As Double
    Dim Key As String

    With ThisWorkbook.Worksheets("Sheet1")

         LastrowH = .Cells(.Rows.Count, "H").End(xlUp).Row

         For i = 2 To LastrowH
            'Check if Key start from DR (we assume that anything start with DR is key we need)
            If Left(.Range("H" & i).Value, 2) = "DR" Then 'Remove this line

                Key = .Range("H" & i).Value
                Amount = .Range("L" & i).Value
                Year = .Range("M" & i).Value
                LastrowR = .Cells(.Rows.Count, "R").End(xlUp).Row
                    .Range("R" & LastrowR + 1).Value = Key
                    .Range("S" & LastrowR + 1).Value = Amount
                    .Range("T" & LastrowR + 1).Value = Year

                    If Year = 2018 Then

                        .Range("R" & LastrowR + 2 & ":R" & LastrowR + 4).Value = Key
                        .Range("S" & LastrowR + 2 & ":S" & LastrowR + 4).Value = Amount
                        .Range("T" & LastrowR + 2).Value = Year + 1
                        .Range("T" & LastrowR + 3).Value = Year + 2
                        .Range("T" & LastrowR + 4).Value = Year + 3

                    End If

            End If 'Remove this line

         Next i

    End With

End Sub

если вы хотите удалить DR (оператор if), удалите строки с 'Удалить эту строку в конце.