Транспонировать данные в Excel на основе количества строк с использованием VBA

Question

У меня есть следующие примеры данных в Excel: -

Type    Reference  
AAA     R  
BBB     A  
ZZZ     R  
AAA     S  
BBB     A  
BBB     A  
ZZZ     S  
AAA     T  
BBB     A  
BBB     A  
ZZZ     T  
AAA     U  
BBB     A  
ZZZ     U  

Тип AAA - это заголовок, а ZZZ - это нижний колонтитул.

Я хотел бы знать, если использовать VBA, можно вывести этот пример данных как:1009 *

Answer 1

Я представляю ответ, потому что это, очевидно, не так тривиально, как выглядит.

Сложность в том, что верхние и нижние колонтитулы AAA и нижние колонтитулы ZZZ происходяттолько один раз, пока данные BBB могут иметь несколько строк.Таким образом, если данные BBB больше 1 строки, нам также нужно расширить колонтитулы до количества строк данных, чтобы получить желаемый вывод OP.

Моему решению не будет важно, как заголовок,нижний колонтитул и значения данных.Это просто предполагает следующую структуру:

• 1 заголовок строки, например, AAA
• n данные строки, например, BBB
• 1 строканижний колонтитул, например ZZZ

Если исходные данные соответствуют этой структуре, код работает.

Это решение будет считывать данные с вашего листа Data

и запишите его на лист Output

Option Explicit

Public Sub ReorganizeData()
    Dim wsData As Worksheet 'data sheet
    Set wsData = ThisWorkbook.Worksheets("Data")

    Dim wsOutput As Worksheet 'output sheet
    Set wsOutput = ThisWorkbook.Worksheets("Output")

    Dim Lastrow As Long 'find the end of the data
    Lastrow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

    Dim iRowOutput As Long
    iRowOutput = 1 'this is where the output starts

    Dim HeaderRow As Long
    Dim StartRow As Long
    Dim EndRow As Long
    Dim FooterRow As Long

    Dim iRow As Long
    For iRow = 2 To Lastrow 'loop throug data
        If HeaderRow = 0 Then
            HeaderRow = iRow 'remember header row
        ElseIf StartRow = 0 Then
            StartRow = iRow 'remember where data BBB starts
        ElseIf Not wsData.Cells(iRow, "A").Value = wsData.Cells(iRow - 1, "A").Value Then
            EndRow = iRow - 1 'remeber where BBB ended
            FooterRow = iRow 'remember footer row

            'copy data to output sheet
            wsOutput.Cells(iRowOutput, "A").Resize(RowSize:=EndRow - StartRow + 1, ColumnSize:=2).Value = wsData.Cells(HeaderRow, "A").Resize(ColumnSize:=2).Value
            wsOutput.Cells(iRowOutput, "C").Resize(RowSize:=EndRow - StartRow + 1, ColumnSize:=2).Value = wsData.Cells(StartRow, "A").Resize(RowSize:=EndRow - StartRow + 1, ColumnSize:=2).Value
            wsOutput.Cells(iRowOutput, "E").Resize(RowSize:=EndRow - StartRow + 1, ColumnSize:=2).Value = wsData.Cells(FooterRow, "A").Resize(ColumnSize:=2).Value

            'calculate new output row
            iRowOutput = iRowOutput + EndRow - StartRow + 1

            'reset row finder variables
            HeaderRow = 0
            StartRow = 0
            EndRow = 0
            FooterRow = 0
        End If
    Next iRow
End Sub