Добрый день
Есть таблица (вложение). Пытаюсь макросом сделать правильную для формирования сводной.
Где каждая группировка - отдельный столбец
Но не получается
что я делаю не так?
Есть таблица (вложение). Пытаюсь макросом сделать правильную для формирования сводной.
Где каждая группировка - отдельный столбец
Но не получается
что я делаю не так?
| Код |
|---|
Sub ConvertGroupedDataToTable()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long
Dim groupLevel As Integer
Dim outputRow As Long
Dim outputColumn As Integer
Dim headers() As String
Dim headerCount As Integer
Dim currentHeaderValues() As Variant
' Укажите лист, содержащий сгруппированные данные
Set ws = ThisWorkbook.Sheets("Sheet1") ' Измените "Sheet1" на имя вашего листа
' Определите последнюю строку с данными
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
' Определите максимальный уровень группировки (предполагаем, что он равен кол-ву отступов)
groupLevel = 0
For i = 1 To lastRow
If ws.Cells(i, 1).IndentLevel > groupLevel Then
groupLevel = ws.Cells(i, 1).IndentLevel
End If
Next i
' Инициализация массивов
ReDim headers(1 To groupLevel + 1) ' +1 для колонки с товаром
ReDim currentHeaderValues(1 To groupLevel)
headerCount = groupLevel + 1
' Определите заголовки столбцов (названия уровней группировки)
For j = 1 To groupLevel
headers(j) = "Уровень " & j ' Можно изменить на что-то более осмысленное
Next j
headers(groupLevel + 1) = "Товар"
' Создайте заголовки в новом листе
Dim outputSheet As Worksheet
Set outputSheet = ThisWorkbook.Sheets.Add
outputSheet.Name = "Таблица для сводной"
For j = 1 To headerCount
outputSheet.Cells(1, j).Value = headers(j)
Next j
' Инициализируем номер строки для вывода
outputRow = 2
' Пройдитесь по каждой строке исходных данных
For i = 1 To lastRow
' Определите уровень группировки текущей строки
Dim currentLevel As Integer
currentLevel = ws.Cells(i, 1).IndentLevel
' Если это не строка с подсуммой/итогом
If Not ws.Cells(i, 1).Font.Bold Then
' Обновите значения заголовков для текущего уровня и выше
For j = 1 To currentLevel
currentHeaderValues(j) = ws.Cells(i, 1).Value
Next j
' Если текущий уровень - максимальный (т.е. это "Товар")
If currentLevel = groupLevel Then
' Запишите данные в выходной лист
For j = 1 To groupLevel
outputSheet.Cells(outputRow, j).Value = currentHeaderValues(j)
Next j
outputSheet.Cells(outputRow, groupLevel + 1).Value = ws.Cells(i, 1).Value ' Значение товара
' Переходим к следующей строке для вывода
outputRow = outputRow + 1
End If
End If
Next i
MsgBox "Преобразование завершено. Сводная таблица готова на листе '" & outputSheet.Name & "'."
End Sub |
Изменено: - 26.03.2025 21:37:27
