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这样输出此样本数据：-

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

逻辑是每个页眉到页脚组的转置行数应等于页眉和页脚之间的BBB行数

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

使用VBA根据行数在Excel中转置数据

1 个答案:

使用VBA根据行数在Excel中转​​置数据

1 个答案:

使用VBA根据行数在Excel中转置数据