如何使用VBA基于列值转换Excel表格结构

实现步骤 #

你可以直接用下方的VBA代码实现表格的逆透视转换，逻辑为读取源表中不需要转换的固定维度列（如姓名、部门），再遍历月度等动态表头列，将每列的数值拆解为单独的行写入新表，不会覆盖原有数据。

前置准备 #

• 将你的源数据所在工作表命名为源数据
• 如果你表格的固定维度列（不参与拆分行的列）数量不是2，可以修改代码中fixedColCount = 2的对应数值

VBA代码 #

Sub 逆透视转换表格()
    Dim sourceSheet As Worksheet, targetSheet As Worksheet
    Dim lastRow As Long, lastCol As Long, fixedColCount As Long
    Dim i As Long, j As Long, targetRow As Long
    
    ' 配置固定维度列数量
    fixedColCount = 2
    Set sourceSheet = ThisWorkbook.Worksheets("源数据")
    ' 新建工作表存放转换结果
    Set targetSheet = ThisWorkbook.Worksheets.Add(after:=sourceSheet)
    targetSheet.Name = "转换后结果"
    
    ' 读取源表最大行、最大列
    lastRow = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = sourceSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' 写入结果表头
    targetSheet.Cells(1, 1) = "姓名"
    targetSheet.Cells(1, 2) = "部门"
    targetSheet.Cells(1, 3) = "月份"
    targetSheet.Cells(1, 4) = "业绩"
    targetRow = 2
    
    ' 遍历源表每一行数据
    For i = 2 To lastRow
        ' 遍历所有需要转换的动态列
        For j = fixedColCount + 1 To lastCol
            ' 复制固定列内容
            targetSheet.Cells(targetRow, 1) = sourceSheet.Cells(i, 1)
            targetSheet.Cells(targetRow, 2) = sourceSheet.Cells(i, 2)
            ' 写入动态列的表头和对应数值
            targetSheet.Cells(targetRow, 3) = sourceSheet.Cells(1, j)
            targetSheet.Cells(targetRow, 4) = sourceSheet.Cells(i, j)
            targetRow = targetRow + 1
        Next j
    Next i
    
    ' 自动调整结果表列宽
    targetSheet.Columns("A:D").AutoFit
    MsgBox "转换完成，结果已存放在【转换后结果】工作表"
End Sub

运行方法 #

• 打开Excel文件后按Alt+F11调出VBA编辑器
• 右键左侧工程栏，选择【插入】-【模块】，将上述代码粘贴到模块中
• 按F5直接运行即可

内容的提问来源于stack exchange，提问作者Hala El Henawy