Question

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

表1看起来像这样：

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

表2需要如下所示：

苹果梨葡萄巴南橙子草莓

Answer 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

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

1 个答案: