作为以前从事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的较早菜单界面找到此技巧的版本: