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