如何将类透视表格式数据转列表？Excel公式/VBA方案咨询

一、Excel动态数组公式实现（优先推荐，适用于Excel 365/2021及以上版本） #

利用Excel内置动态数组函数组合，可实现自动更新的逆透视，无需手动操作。假设你的源数据满足：

• 行标签位于A列（第2行及以下为数据行）
• 列标签位于第1行（B列及以后为数据列）
• 数值区域为B2:CV350（对应350行×100列规模）

直接在空白单元格（比如Sheet2的A1）输入以下公式，回车后自动生成完整列表格式数据，数据更新时公式会自动刷新：

=HSTACK(
    INDEX(A:A, SEQUENCE(ROWS(B2:CV350)*COLUMNS(B2:CV350),,2)),
    INDEX(TOROW(B1:CV1,1,1), MOD(SEQUENCE(ROWS(B2:CV350)*COLUMNS(B2:CV350),,0), COLUMNS(B2:CV350))+1),
    TOCOL(B2:CV350,1)
)

公式说明：

• INDEX(A:A, SEQUENCE(...))：生成重复的行标签，匹配每个数值对应的行
• INDEX(TOROW(...), MOD(...))：生成重复的列标签，匹配每个数值对应的列
• TOCOL(B2:CV350,1)：将二维数值区域转为单列
• HSTACK：将上述三列横向合并为最终列表结构

二、VBA实现方案（适用于全版本Excel，完全自动化） #

若使用旧版Excel（不支持动态数组），或需要更灵活的定制，可采用VBA宏实现自动逆透视。

1. 核心逆透视宏代码 #

打开VBA编辑器（按Alt+F11），插入标准模块，粘贴以下代码：

Sub ReversePivot()
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim srcLastRow As Long, srcLastCol As Long
    Dim destRow As Long, i As Long, j As Long
    
    ' 替换为你的源工作表和目标工作表名称
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set destWS = ThisWorkbook.Sheets("Sheet2")
    
    ' 清空目标表旧数据（保留表头）
    destWS.Range("A2:Z" & destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 获取源数据的实际范围
    srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
    srcLastCol = srcWS.Cells(1, srcWS.Columns.Count).End(xlToLeft).Column
    
    destRow = 2 ' 目标数据起始行
    
    ' 遍历源数据完成逆透视
    For i = 2 To srcLastRow
        For j = 2 To srcLastCol
            destWS.Cells(destRow, "A").Value = srcWS.Cells(i, "A").Value ' 行标签
            destWS.Cells(destRow, "B").Value = srcWS.Cells(1, j).Value ' 列标签
            destWS.Cells(destRow, "C").Value = srcWS.Cells(i, j).Value ' 数值
            destRow = destRow + 1
        Next j
    Next i
    
    ' 自动调整列宽
    destWS.Columns("A:C").AutoFit
End Sub

2. 实现自动触发 #

双击源工作表（如Sheet1）的代码窗口，粘贴以下事件代码，确保源数据更新时自动执行逆透视：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim srcLastRow As Long, srcLastCol As Long
    srcLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
    srcLastCol = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
    
    ' 仅当源数据区域有修改时触发
    If Not Intersect(Target, Me.Range("A1:" & Me.Cells(srcLastRow, srcLastCol).Address)) Is Nothing Then
        ReversePivot
    End If
End Sub

3. 配置说明 #

• 保存工作簿为**启用宏的工作簿（.xlsm）**格式
• 首次打开时需启用宏，之后源数据修改会自动同步更新逆透视结果

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