Создайте лист Итог для плоской таблицы
Макрос в модуль листа TDSheet (только очистите часть Нужно так:)
| Код |
|---|
Sub Agent()
Dim iLastRow_1 As Long
Dim iLastRow_2 As Long
Dim i As Long
With Application
.ScreenUpdating = False 'отключение обновление экрана
.Calculation = xlCalculationManual 'отключение пересчёт формул вручную
.DisplayAlerts = False 'отключение предупреждающих сообщений
End With
With Sheets("Итог")
.Cells.Clear ' очищаем лист Итог
.Range("A1:F1") = Array("Агент", "Контрагент", "Торговая точка", "Номенклатура", _
"Сумма продажи в Рубль", "Вес (кг)")
iLastRow_1 = Cells(Rows.Count, 2).End(xlUp).Row
For i = 14 To iLastRow_1 'таблица с 14 строки
iLastRow_2 = .Cells(.Rows.Count, 4).End(xlUp).Row + 1
If Cells(i, 2).IndentLevel = 0 Then
.Cells(iLastRow_2, 1) = Cells(i, 2) 'агент
ElseIf Cells(i, 2).IndentLevel = 1 Then
.Cells(iLastRow_2, 2) = Cells(i, 2) 'контрагент
ElseIf Cells(i, 2).IndentLevel = 2 Then
.Cells(iLastRow_2, 3) = Cells(i, 2) 'торговая точка
ElseIf Cells(i, 2).IndentLevel = 3 Then
.Cells(iLastRow_2, 4) = Cells(i, 2) 'номенклатура
.Cells(iLastRow_2, 5) = Cells(i, 3) 'сумма продаж
.Cells(iLastRow_2, 6) = Cells(i, 4) 'вес
End If
Next
.Range("E2:F" & iLastRow_2).NumberFormat = "# ##0.00"
.Range("E2:F" & iLastRow_2).HorizontalAlignment = xlRight
'заполнение пустых ячеек данными из вышестоящей ячейки
With .Range("A1:F" & iLastRow_2)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
End With
End Sub
|
