将Excel标头转换为行列表

Question

我需要将一组列（表1）转换为合并的行（表2），如下图所示：

我有一个更大的数据库，其中有24个“待转换”列和许多初始行（约10k）。我已经为此编写了VBA代码，但实际上我对复制和粘贴解决方案不满意。

对此有什么好的解决方案？真的需要使用VBA吗？

Ps：我希望我的数据像表2一样，因为这样更容易控制我的数据。那有意义吗？ （例如：如果我想对所有具有“名称”等于“约翰”的“值”与“月”等于2月或3月的所有“值”进行求和）

Answer 1

更新两个范围（输入和输出），并查看下面的示例。有任何问题请随时询问我（们）。您将失去颜色，但是我将使用“条件格式设置”来代替它，而不是通过编程方式设置每个ID的颜色

Option Explicit
Public Sub TranposeData()
    Dim InputArr As Variant, OutputArr As Variant
    Dim rng As Range
    Dim i As Long, j As Long
    Dim OutputRow As Long

    ' Update this to your input range
    With Sheet1
        Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
    End With

    InputArr = rng.Value2

    ReDim OutputArr(1 To UBound(InputArr, 1) * UBound(InputArr, 2), 1 To 3)

    OutputRow = LBound(OutputArr, 1)

    For j = LBound(InputArr, 2) + 1 To UBound(InputArr, 2)
        For i = LBound(InputArr, 1) + 1 To UBound(InputArr, 1)
            OutputArr(OutputRow, 1) = InputArr(i, 1)
            OutputArr(OutputRow, 2) = InputArr(1, j)
            OutputArr(OutputRow, 3) = InputArr(i, j)
            OutputRow = OutputRow + 1
        Next i
    Next j

    ' Update this to your output range
    Sheet1.Cells(2, 13).Resize(UBound(OutputArr, 1), UBound(OutputArr, 2)).Value2 = OutputArr
End Sub