代码之家 › 专栏 › 技术社区 › bd528

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

vba excel

-2

bd528 · 技术社区 · 6 年前

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行数

1 回复 | 直到 6 年前

Pá´Ê 6 年前

我发布了一个答案,因为这显然不像看上去那么琐碎。

AAA 和页脚 ZZZ 仅发生一次,而数据 BBB BBB 如果超过1行,我们还需要将页眉和页脚扩展到数据行的数量,以获得OP所需的输出。

1 行标题,例如。
n 行数据,例如。 BBB
1.

如果原始数据遵循此结构,则代码有效。

此解决方案将从工作表中读取数据 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

推荐文章