Страницы: 1
RSS
Автоматическое добавление строки "Всего по странице"
 
Нашел в интернете макрос, который почти идеально подходит для решения задачи. Но поскольку VBA я не владею, то допилить код до идеала сам не могу. Суть того, что хотелось бы получить на итог при исполнении макроса:
- Автоматическое добавление строки с промежуточным итогом. Суммироваться должен столбец "G"
- Вместе с добавлением этой строки в столбце "H" должно появляться слово "ИСТИНА"
- Текст в столбце "D" должке быть "Итого без НДС" вместо "Итого по странице"
- Текст в столбце "F" должке быть "х" (типо просто крестик))))
- В этом макросе суммируются еще другие столбцы, мне они не нужны. Нужен только один столбец "G"
- В этом макросе на последней странице еще добавляется строка "Всего приход". Мне нужно вместо нее три строки с текстом в столбце "D"
                a. "Всего по акту без учета НДС" - которая будет отображать сумму всего столбца "G" без учета промежуточных итогов на каждом листе.
                b. "НДС" c формулой =ОКРУГЛ(строка a*0,2;2)
                c. Всего по акту с учётом НДС  c формулой сумма двух предыдущих
Причем эти три строки должны появиться сразу после таблицы, поскольку ниже нее идут еще данные (фамилии, должности и т.д)
- Очень нужно оставить возможность удалить сделанные строки
Изменено: bda963 - 07.12.2023 13:49:19
 
Код
Option Explicit

Const FIRST_ROW& = 10
Const FIRST_COL$ = "I"
Const LAST_COL$ = "V"
Const ITOGO_COL$ = "D"

Sub CreatePageSubtotals()
Dim iPageNum&, viewState, hpb As HPageBreak, iRow1&, iRow2&

viewState = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
iRow1 = FIRST_ROW
For Each hpb In ActiveSheet.HPageBreaks
    iPageNum = iPageNum + 1
    iRow2 = hpb.Location.Row - 1
    Rows(iRow2).Insert
    Cells(iRow2, ITOGO_COL) = "Итого по странице " & iPageNum & ":"
    Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL)).FormulaR1C1 = _
        "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    Rows(iRow2).Font.Bold = True
    iRow1 = iRow2 + 1
Next

iRow2 = Cells(Rows.Count, FIRST_COL).End(xlUp).Row + 1
Cells(iRow2, ITOGO_COL) = "Итого по странице " & iPageNum + 1 & ":"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With
Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
iRow2 = iRow2 + 1
Cells(iRow2, ITOGO_COL) = "Всего приход:"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

ActiveWindow.View = viewState
'Всего приход:
End Sub

Sub RemovePageSubtotals()
On Error Resume Next
Cells(FIRST_ROW, FIRST_COL).RemoveSubtotal
End Sub
Изменено: bda963 - 07.12.2023 18:02:46
 
А теперь ко всему этому описанию приложите файл-пример. Как есть - Как надо
Изменено: Sanja - 07.12.2023 13:43:31
Согласие есть продукт при полном непротивлении сторон
 
Sanja, подумал, что лучше вторым сообщением выложить код и файл. Чтобы в одну кучу все не сваливать ;)  
 
Поковырялся сам. Методом научного тыка удалось добиться немного. Помогите пожалуйста допилить до нужной формы.
Код
Option Explicit

Const FIRST_ROW& = 10
Const FIRST_COL$ = "G"
Const LAST_COL$ = "G"
Const ITOGO_COL$ = "D"

Sub CreatePageSubtotals()
Dim iPageNum&, viewState, hpb As HPageBreak, iRow1&, iRow2&

viewState = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
iRow1 = FIRST_ROW
For Each hpb In ActiveSheet.HPageBreaks
    iRow2 = hpb.Location.Row - 1
    Rows(iRow2).Insert
    Cells(iRow2, ITOGO_COL) = "Итого без НДС"
    Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL)).FormulaR1C1 = _
        "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    Rows(iRow2).Font.Bold = True
    iRow1 = iRow2 + 1
Next

iRow2 = Cells(Rows.Count, FIRST_COL).End(xlUp).Row + 1
Cells(iRow2, ITOGO_COL) = "Итого без НДС"

With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
iRow2 = iRow2 + 1
Cells(iRow2, ITOGO_COL) = "Всего по акту без учета НДС"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
iRow2 = iRow2 + 1
Cells(iRow2, ITOGO_COL) = "НДС"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
iRow2 = iRow2 + 1
Cells(iRow2, ITOGO_COL) = "Всего по акту с учётом НДС
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

ActiveWindow.View = viewState
'Всего приход:
End Sub

Sub RemovePageSubtotals()
On Error Resume Next
Cells(FIRST_ROW, FIRST_COL).RemoveSubtotal
End Sub
Изменено: bda963 - 07.12.2023 17:29:43
Страницы: 1
Наверх