如何使用VBA实现指定格式的表格转置？

以下是实现你需求的VBA代码，可直接运行转换表格结构：

Sub TransposeTable()
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim srcData As Variant, destData As Variant
    Dim itemList As Collection, nameList As Collection
    Dim i As Long, j As Long, k As Long
    Dim currentItem As String
    
    ' 指定源表和目标表（自行修改工作表名称）
    Set srcWS = ThisWorkbook.Worksheets("Sheet1")
    Set destWS = ThisWorkbook.Worksheets("Sheet2")
    destWS.Cells.Clear
    
    ' 读取源数据到数组（假设数据从A1开始，包含表头）
    srcData = srcWS.Range("A1").CurrentRegion.Value
    
    ' 收集唯一的Item编号和姓名
    Set itemList = New Collection
    Set nameList = New Collection
    On Error Resume Next
    For i = 2 To UBound(srcData)
        itemList.Add CStr(srcData(i, 1)), Key:=CStr(srcData(i, 1))
        nameList.Add CStr(srcData(i, 2)), Key:=CStr(srcData(i, 2))
    Next i
    On Error GoTo 0
    
    ' 初始化目标数据数组（匹配你要的列数和行数）
    ReDim destData(1 To itemList.Count + 3, 1 To 5)
    
    ' 填充第一行表头
    destData(1, 1) = "Item"
    destData(1, 2) = "John"
    destData(1, 4) = "Bob"
    destData(1, 5) = "Suzy"
    
    ' 填充第二行子表头
    destData(2, 1) = "Item#"
    destData(2, 2) = "Value"
    destData(2, 3) = "Quantity"
    destData(2, 4) = "Value"
    destData(2, 5) = "Value"
    
    ' 填充分隔线行
    destData(3, 1) = "----------"
    destData(3, 2) = "------"
    destData(3, 3) = "--------"
    destData(3, 4) = "------"
    destData(3, 5) = "-------"
    
    ' 匹配并填充数据
    For i = 1 To itemList.Count
        currentItem = itemList(i)
        destData(i + 3, 1) = currentItem
        
        For k = 2 To UBound(srcData)
            If srcData(k, 1) = currentItem Then
                Select Case srcData(k, 2)
                    Case "John"
                        destData(i + 3, 2) = srcData(k, 3)
                        destData(i + 3, 3) = srcData(k, 4)
                    Case "Bob"
                        destData(i + 3, 4) = srcData(k, 3)
                    Case "Suzy"
                        destData(i + 3, 5) = srcData(k, 3)
                End Select
            End If
        Next k
    Next i
    
    ' 将数组写入目标表
    destWS.Range("A1").Resize(UBound(destData, 1), UBound(destData, 2)).Value = destData
    
    ' 自动调整列宽
    destWS.UsedRange.Columns.AutoFit
End Sub

使用步骤 #

1. 把源数据放在Excel的Sheet1中，确保表头是Item#、姓名、Value、Quantity，数据从A1开始。
2. 新建一个Sheet2用于存放转换后的结果（若不存在可手动创建）。
3. 按下Alt+F11打开VBA编辑器，插入模块，粘贴上述代码。
4. 运行TransposeTable宏即可完成转换。

代码说明 #

• 先读取源数据，收集所有唯一的Item编号和姓名。
• 按照目标表格结构初始化数组，填充表头、子表头和分隔线。
• 遍历每个Item编号，匹配对应姓名的Value和Quantity数据，填充到目标数组对应位置。
• 最后将数组写入目标工作表，完成转置。

内容的提问来源于stack exchange，提问作者Dinda