我如何组合/透明的分离数据

时间:2019-01-25 12:28:00

标签: excel vba

我有2019年至2021年以及2016年至2018年的数据。我想将数据与要遵循的KeyNumbers相结合,我认为通过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

enter image description here

enter image description here

1 个答案:

答案 0 :(得分: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语句),请删除结尾处带有'删除此行的行。