Трехмерные транспозиции (Microsoft Excel)
Как бывший опытный пользователь Lotus 1-2-3 на предыдущей работе, Патти ОЧЕНЬ привязалась к функции, которой сильно не хватает Excel: способности переносить данные в трех измерениях. Двумерное транспонирование поддерживается в Excel, но Патти не придумала, как взять строку, столбец или таблицу и распределить ее по стопке листов. Это была функция, которой ежедневно пользовались все в ее финансовом офисе, и она очень скучала по ней.
Патти права; в Excel нет встроенной функции для этого. Ближайший вариант — использовать сводную таблицу и возможности «Показать страницы», которые она включает. Как правило, вы выполняете следующие действия:
-
Создайте сводную таблицу из ваших данных, как обычно.
-
Поместите столбец, из которого вы хотите создать рабочие листы, в раздел «Страницы» сводной таблицы.
-
На панели инструментов сводной таблицы щелкните параметр «Сводная таблица» в левой части панели инструментов. Excel отображает ряд вариантов, которые вы можете выбрать.
-
Выберите Показать страницы. Excel попросит вас подтвердить, что вы хотите показать страницы.
-
Щелкните ОК.
В итоге вы получите серию рабочих листов, по одному на каждую запись столбца, который вы указали на шаге 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), я подготовил специальную страницу, содержащую полезную информацию.
link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].
ExcelTips — ваш источник экономичного обучения Microsoft Excel.
Этот совет (11245) применим к Microsoft Excel 97, 2000, 2002 и 2003.
Вы можете найти версию этого совета для ленточного интерфейса Excel (Excel 2007 и новее) здесь:
link: / excelribbon-Трехмерные_перемещения [Трехмерные транспозиции].