Excel VBA 将重复 header 的动态列表转置为新的 sheet

Question

我需要复制一个包含重复 header 的数据列表并将其转置到另一个 sheet。 VBA 需要容纳不同大小和数量的列表。

Sheet 1 看起来像这样：

水果
苹果
梨
葡萄
水果
香蕉
橙色
草莓

Sheet 2 需要如下所示：

苹果梨葡萄
香蕉橙草莓

Answer 1

假设没有空白行并且您的列表在 A 列中并且当您运行宏

时工作表 1 处于活动状态

Sub flip_it()
Dim RowCount As Long
Dim SrcRng As Range
Rows(1).Insert
RowCount = Range("A1048576").End(xlUp).Row
Range("B1:B" & RowCount).FormulaR1C1 = "=if(RC[-1]=""FRUIT"",row(),""x"")"
Range("B1:B" & RowCount).Value = Range("B1:B" & RowCount).Value
Range("B1:B" & RowCount).RemoveDuplicates 1, xlNo
Range("C1").FormulaR1C1 = "=Counta(C2)"

    For x = 2 To Range("C1").Value
        row1 = Range("B" & x).Value + 1
            If x = Range("c1").Value Then
                row2 = RowCount
            Else
                row2 = Range("B" & x + 1).Value - 1
            End If
        Set SrcRng = Range(Cells(row1, 1), Cells(row2, 1))
        SrcRng.Copy

        With Worksheets("Sheet2")
            .Range("A" & x - 1).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, skipblanks, Transpose:=True
        End With

    Next x

Worksheets("Sheet2").Activate

End Sub

Excel VBA 将重复 header 的动态列表转置为新的 sheet

Excel VBA Transpose dynamic list with repeating header to new sheet

excel

vba

transpose