如何使用Excel VBA将垂直列表转换为动态水平二维表

本方案支持自动识别所有不固定的Feature ID生成列头，兼容文本、数值混合的Feature Value，无需根据特征数量修改代码。

使用步骤 #

• 打开目标Excel文件，按下Alt + F11调出VBA编辑器
• 在左侧项目面板右键点击当前工作簿名称，选择「插入」-「模块」
• 将下方代码粘贴到新建的模块窗口中
• 按下F5运行即可，建议运行前备份原始数据避免误操作

完整VBA代码 #

Sub 三列转动态水平表()
    Dim srcSht As Worksheet, outSht As Worksheet
    Dim refDict As Object, featDict As Object
    Dim lastRow As Long, i As Long, refRow As Long, featCol As Long
    Dim refVal As String, featVal As String, valueVal As Variant
    
    ' 工作表配置，可根据实际存储位置修改名称
    Set srcSht = ThisWorkbook.Worksheets("Sheet1") ' 原始数据所在工作表
    Set outSht = ThisWorkbook.Worksheets("Sheet2") ' 结果输出工作表
    Set refDict = CreateObject("Scripting.Dictionary")
    Set featDict = CreateObject("Scripting.Dictionary")
    
    ' 清空输出表原有内容
    outSht.Cells.Clear
    
    ' 获取原始数据最后一行行号
    lastRow = srcSht.Cells(srcSht.Rows.Count, "A").End(xlUp).Row
    
    ' 提取唯一Reference和Feature ID，预分配行列位置
    For i = 2 To lastRow ' 跳过第1行表头，从数据行开始读取
        refVal = srcSht.Cells(i, "A").Value
        featVal = srcSht.Cells(i, "B").Value
        
        ' 记录Reference对应的输出行号，输出表第1行为表头，行号从2开始
        If Not refDict.Exists(refVal) Then
            refDict(refVal) = refDict.Count + 2
        End If
        
        ' 记录Feature ID对应的输出列号，输出表第1列为Reference，列号从2开始
        If Not featDict.Exists(featVal) Then
            featDict(featVal) = featDict.Count + 2
        End If
    Next i
    
    ' 生成输出表表头
    outSht.Cells(1, 1).Value = "Reference"
    ' 写入Feature ID列头
    For Each featVal In featDict.Keys
        outSht.Cells(1, featDict(featVal)).Value = featVal
    Next featVal
    ' 写入Reference行头
    For Each refVal In refDict.Keys
        outSht.Cells(refDict(refVal), 1).Value = refVal
    Next refVal
    
    ' 匹配填充Feature Value
    For i = 2 To lastRow
        refVal = srcSht.Cells(i, "A").Value
        featVal = srcSht.Cells(i, "B").Value
        valueVal = srcSht.Cells(i, "C").Value
        
        refRow = refDict(refVal)
        featCol = featDict(featVal)
        outSht.Cells(refRow, featCol).Value = valueVal
    Next i
    
    ' 自动调整列宽，可根据需要注释删除
    outSht.Columns.AutoFit
    
    MsgBox "转换完成，结果已保存至" & outSht.Name & "工作表", vbInformation
End Sub

调整说明 #

• 如果原始数据的三列不是A/B/C列，可修改代码中Cells(i, "A")、Cells(i, "B")、Cells(i, "C")的列标识
• 如果原始数据表头不在第1行，可修改循环起始的i = 2为对应数据起始行号
• 如果运行提示缺少组件，可在VBA编辑器顶部菜单选择「工具」-「引用」，勾选「Microsoft Scripting Runtime」后重新运行即可

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