作为以前从事Lotus 1-2-3的重载用户，Patti非常重视Excel所缺乏的一项功能：可以在三个维度上转换数据。 Excel支持二维换位，但是Patti尚未找到一种获取行，列或表并将其分布在工作表堆栈中的方法。她财务办公室的每个人每天都使用此功能，但她确实很想念它。

帕蒂是对的；在Excel中没有内置函数可以执行此操作。最接近的选项是使用数据透视表及其包含的“显示页面”功能。通常，请按照以下步骤操作：

。照常从数据创建数据透视表。

。将您要从其创建工作表的列放入数据透视表的“报告筛选器”部分。

。显示功能区的“选项”选项卡。 （仅当您在数据透视表上工作时，此选项卡才可见。）

。单击功能区左端的“数据透视表”组中“选项”工具旁边的向下箭头。

。选择显示报告过滤器页面。 Excel要求您确认要显示页面。

。 6单击确定。

最终得到的是一系列工作表，每个工作表对应在步骤2中指定的列中的每个条目。这些工作表每个都包含数据透视表的“页面”。

如果这仍然不能完全满足您的要求，那么您将需要使用宏来转置数据。这样的宏可能会变得非常复杂，但是基本上它所要做的就是单步浏览数据表并将数据的每一行（或每一列）移到其自己的工作表中。

例如，以下宏（Transpose3D）将从选定的单元格区域中获取每一行，并将该行放置在自己的新创建的工作表中。

Sub Transpose3D()

Dim rngTbl As Range     Dim wsName As String     Dim R As Integer     Dim C As Integer     Dim i As Integer     Dim j As Integer     Dim Killit As Integer     Dim RCount As Integer     Dim CCount As Integer     Dim Table1() As Variant     Dim Row1() As Variant

RCount = Selection.Rows.Count     CCount = Selection.Columns.Count     If RCount < 2 Then         MsgBox ("Error; Select a range with more than one row.")

GoTo EndItAll     End If

wsName = ActiveSheet.Name     R = ActiveCell.Row     C = ActiveCell.Column

Set rngTbl = Selection     ReDim Table1(1 To RCount, 1 To CCount)

ReDim Row1(1 To 1, 1 To CCount)

Table1() = rngTbl.Value

On Error GoTo Abend

For i = 1 To RCount          If SheetExists(wsName & "_Row_" & i) Then             Killit = MsgBox("Sheet " & wsName & "_Row_" & i & _               " Already Exists!" & vbCrLf & _               "     Cancel: Stop Transposition" & vbCrLf & _               "     OK: Delete Sheet and Continue", vbOKCancel)

If Killit = vbCancel Then GoTo EndItAll             Application.DisplayAlerts = False             Sheets(wsName & "_Row_" & i).Delete             Application.DisplayAlerts = True         End If

Sheets.Add         ActiveSheet.Name = wsName & "_Row_" & i         Cells(R, C).Select         For j = 1 To CCount             Row1(1, j) = Table1(i, j)

Next j         Range(ActiveCell, ActiveCell.Offset(0, CCount - 1)) = Row1()

Sheets(wsName).Select     Next i     GoTo EndItAll

Abend:

MsgBox ("Error in Routine Transpose3D.")



EndItAll:

Application.DisplayAlerts = True End Sub
Function SheetExists(SheetName As String) As Boolean     Dim ws As Worksheet     SheetExists = False     For Each ws In ThisWorkbook.Worksheets         If ws.Name = SheetName Then             SheetExists = True             Exit For         End If     Next ws End Function

注意：

如果您想知道如何使用此页面（或_ExcelTips_网站上的任何其他页面）中描述的宏，我准备了一个特殊页面，其中包含有用的信息。

点击此处在新的浏览器标签中打开该特殊页面。

_ExcelTips_是您进行经济高效的Microsoft Excel培训的来源。

本技巧（11246）适用于Microsoft Excel 2007、2010、2013、2016、2019和Office 365中的Excel。您可以在此处为Excel的较早菜单界面找到此技巧的版本：

三维换位。