Переформатирование данных Excel определенным образом

Question

У меня есть лист Excel, в котором есть 10 разных столбцов с несколькими сотнями записей.

Например,

column1|column2|column3|column4

data    data    data    data

У меня есть другой лист, шаблон с заголовкамиопределенным образом, например,

column1|column2
data    data
        column3   column 4
        data      data

Итак, блок шаблона на моем втором листе должен быть скопирован и заполнен для каждой записи.

Есть ли способ сделать это сVBA?

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

Answer 1

Попробуйте это:

Sub Tester()

    Const SHT_SRC As String = "Sheet1" 'sheet w source data
    Const SHT_DEST As String = "Sheet2" 'sheet w template
    Const RNG_COPY As String = "A1:E6" 'your template area

    Dim rngDest As Range, rngSrc As Range, rngCopy As Range

    Set rngCopy = ThisWorkbook.Sheets(SHT_DEST).Range(RNG_COPY)
    Set rngDest = rngCopy.Cells(1)
    Set rngSrc = ThisWorkbook.Sheets(SHT_SRC).Rows(2)

    Do While rngSrc.Cells(1).Value <> ""

        rngCopy.Copy rngDest 'copy template area
        With rngDest
            'adjust offsets to fit your template layout
            .Offset(1, 0).Value = rngSrc.Cells(1).Value
            .Offset(1, 1).Value = rngSrc.Cells(2).Value
            '...etc etc
            .Offset(5, 5) = rngSrc.Cells(10).Value
        End With

        Set rngDest = rngDest.Offset(rngCopy.Rows.Count + 1, 0)
        Set rngSrc = rngSrc.Offset(1, 0)
    Loop

End Sub

Answer 2

Вы можете прочитать диапазон в массив, а затем разобрать его по отдельным элементам:

Dim dataArray As Variant
Dim i As Integer

dataArray = Range("B1:B4").Value

For i = 1 to Ubound(dataArray)/2
  Range("B2").Offset(2 * (Ceiling(i/2)-1), Ceiling((i-1)/2)) = dataArray(1, i)
Next i

Использование этой функции:

Public Function Ceiling(ByVal X As Double) As Integer

  Ceiling = Int(X) - (X - Int(X) > 0)

End Function