Как я могу перенести этот набор данных в этот конкретный порядок? - PullRequest
Новая
       9

Как я могу перенести этот набор данных в этот конкретный порядок?

0 голосов
/ 18 января 2019

Я использую Excel 2016, и у меня есть набор данных с 492 строками и без заголовков. Данные начинаются с ячейки A1.

Извлечение набора данных выглядит следующим образом:

extract

Я хочу перенести этот набор данных в следующий формат:

expected output

Я новичок в VBA, и мне трудно найти правильное решение. Я попытался записать транспонирование как Macro (шаг за шагом) и просмотрел коды VBA, но я все еще не могу собрать его вместе.

1 Ответ

0 голосов
/ 18 января 2019

Попробуйте этот код, но перед тем как вы отрегулируете две константы вверху, чтобы они соответствовали фактам на вашем рабочем листе. Рабочий лист с данными должен быть активным при выполнении кода. 

Sub TransposeData()

    Const FirstDataRow As Long = 2              ' presuming row 1 has headers
    Const YearColumn As String = "A"            ' change as applicable

    Dim Rng As Range
    Dim Arr As Variant, Pos As Variant
    Dim Rl As Long, Cl As Long
    Dim R As Long, C As Long
    Dim i As Long

    With ActiveSheet
        Cl = .UsedRange.Columns.Count - .UsedRange.Column + 1
        Rl = .Cells(.Rows.Count, Columns(YearColumn).Column).End(xlUp).Row
        Set Rng = Range(.Cells(FirstDataRow, YearColumn), .Cells(Rl, Cl))
    End With
    Arr = Rng.Value
    ReDim Pos(1 To (UBound(Arr) * UBound(Arr, 2)), 1 To 2)

    For R = 1 To UBound(Arr)
        For C = 2 To UBound(Arr, 2)
            i = i + 1
            Pos(i, 1) = Arr(R, 1)
            Pos(i, 2) = Arr(R, C)
        Next C
    Next R

    R = Rl + 5                                  ' write 5 rows below existing data
    Set Rng = ActiveSheet.Cells(R, YearColumn).Resize(i, 2)
    Rng.Value = Pos
End Sub
...