如何轻松转置Tableau导出至Excel的这类数据？

你需要的格式转换，Excel现在有内置的无代码解决方案，不需要依赖VBA，优先推荐以下两种方法：

方法1：Power Query（获取与转换数据） #

这是最直观且易维护的方法，适合Excel 2016及以后版本：

• 选中包含表头的完整数据区域，点击「数据」选项卡 → 「从表格/区域」（旧版本需启用Power Query插件）
• 在Power Query编辑器中，选中要转成列标题的B列，点击「转换」选项卡 → 「透视列」
• 在弹窗中，「值列」选择你要展示的对应数据列，「高级选项」选择**「不要聚合」**（确保保留原始值，不自动求和/计数）
• 点击确定后，数据会直接转换成目标格式，最后点击「关闭并上载」，将结果导入新工作表即可

方法2：数据透视表 #

如果习惯用数据透视表，也能快速实现：

• 选中数据区域，点击「插入」选项卡 → 「数据透视表」，选择结果放置的位置
• 在字段列表中：
  • 把A列拖到「行」区域
  • 把B列拖到「列」区域
  • 把对应的数据列拖到「值」区域
• 若需要保留原始值，右键点击值字段 → 「值字段设置」，选择「值」（或根据需求调整为其他非聚合选项），最后调整格式即可

备选：VBA代码实现 #

如果你还是需要用VBA，这里提供一个简化版的代码，直接运行即可生成目标格式：

Sub ConvertToCrossTab()
    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim lastRow As Long, uniqueCount As Long
    Dim uniqueHeaders As Collection
    Dim i As Long, j As Long, k As Long
    
    ' 定义源工作表和新建结果工作表
    Set srcSheet = ActiveSheet
    Set destSheet = ThisWorkbook.Sheets.Add(After:=srcSheet)
    destSheet.Name = "转换结果"
    
    ' 获取源数据最后一行
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 收集B列的唯一值作为列标题
    Set uniqueHeaders = New Collection
    On Error Resume Next
    For i = 2 To lastRow
        uniqueHeaders.Add srcSheet.Cells(i, "B").Value, Key:=CStr(srcSheet.Cells(i, "B").Value)
    Next i
    On Error GoTo 0
    uniqueCount = uniqueHeaders.Count
    
    ' 写入表头
    destSheet.Cells(1, 1).Value = srcSheet.Cells(1, "A").Value
    For j = 1 To uniqueCount
        destSheet.Cells(1, j + 1).Value = uniqueHeaders(j)
    Next j
    
    ' 填充交叉表数据
    Dim rowMatch As Long, colMatch As Long
    For i = 2 To lastRow
        ' 匹配行标题
        rowMatch = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row + 1
        For j = 2 To rowMatch
            If destSheet.Cells(j, "A").Value = srcSheet.Cells(i, "A").Value Then
                rowMatch = j
                Exit For
            End If
        Next j
        If destSheet.Cells(rowMatch, "A").Value <> srcSheet.Cells(i, "A").Value Then
            destSheet.Cells(rowMatch, "A").Value = srcSheet.Cells(i, "A").Value
        End If
        
        ' 匹配列标题并写入数据
        For k = 2 To uniqueCount + 1
            If destSheet.Cells(1, k).Value = srcSheet.Cells(i, "B").Value Then
                destSheet.Cells(rowMatch, k).Value = srcSheet.Cells(i, "C").Value ' 数据列请根据实际修改
                Exit For
            End If
        Next k
    Next i
    
    ' 自动调整列宽
    destSheet.UsedRange.Columns.AutoFit
End Sub

注意：代码中默认数据在A-C列，若你的数据列不同，修改srcSheet.Cells(i, "C").Value中的列号即可。

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