Excel VBA将带有重复标题的动态列表转置到新工作表答案

【问题标题】：Excel VBA Transpose dynamic list with repeating header to new sheetExcel VBA将带有重复标题的动态列表转置到新工作表
【发布时间】：2016-12-13 02:10:40
【问题描述】：

我需要复制带有重复标题的数据列表并将其转置到另一张纸上。 VBA 需要适应不同大小和数量的列表。

表 1 如下所示：

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

表 2 需要如下所示：

苹果梨葡萄
香蕉橙草莓

【问题讨论】：

Transpose a range in VBA的可能重复
所以你需要这样做，很酷。是什么把你带到这里来的？您是否尝试编写程序并卡住了？有任何问题吗？我们能提供什么帮助？

标签： excel vba transpose

【解决方案1】：

假设没有空白行，并且您的列表在 A 列中，并且在您运行宏时 Worksheet1 处于活动状态

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

【讨论】：

这很好用！如何进行小修改？：水果标题在 A 列，但要复制和转置的数据在 B 列。