Страницы: 1
RSS
Автосумма через макрос
 
Всем привет!

Начал изучать макросы в Excel и резко столкнулся с простой (для кого-то задачей)

Есть таблица. Нужно сделать чтобы в 8, 9 и 10 (залиты жёлтым) столбцах внизу выводилась сумма(ячейки залиты красным)
Проблема в том, что каждый раз длинна данных столбцов разная.  
 
Цитата
Анатолий Патрикеев написал:
Начал изучать макросы в Excel
Почитайте тут:
КАК ОПРЕДЕЛИТЬ ПОСЛЕДНЮЮ ЯЧЕЙКУ НА ЛИСТЕ ЧЕРЕЗ VBA?
Изменено: Msi2102 - 29.09.2022 10:26:05
 
Анатолий Патрикеев,
можно использовать сводную, там есть сумма
или макрос:
Код
Sub aa()
c = 10 'номер столбца
lLastRow = Cells(Rows.Count, c).End(xlUp).Row
Cells(lLastRow + 1, c) = Application.Sum(Range(Cells(2, c), Cells(lLastRow, c)))
End Sub
Изменено: evgeniygeo - 29.09.2022 10:32:54
 
Кто-то может пример показать?
 
Анатолий Патрикеев,
почитайте тут, чтобы понять, как добавить макрос в Ваш файл
https://www.planetaexcel.ru/techniques/3/59/
Изменено: evgeniygeo - 29.09.2022 13:51:29
 
А вам готового кода мало?
 
сколько раз такой макрос применить - ровно столько раз сумма увеличится в 2 раза по сравнению с предыдущим результатом
Изменено: Ігор Гончаренко - 29.09.2022 14:09:12
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
https://www.youtube.com/watch?v=zxhjLGX524E&t=6s
Можно тут посмотреть ☝️
 
еще как вариант
Код
Function сум(n)
lLastRow = Cells(Rows.Count, n.Column).End(xlUp).Row
сум = Application.sum(Range(Cells(n.Row, n.Column), Cells(lLastRow - 1, n.Column)))
End Function
 
Ну и ещё вариант "с автозапуском". В модуль листа.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim yy As Long
    Dim xx As Long
    yy = Cells(Rows.Count, 2).End(xlUp).Row
    Dim arr As Variant
    arr = Cells(1, 8).Resize(yy, 3)
    Dim brr As Variant
    ReDim brr(1 To 1, 1 To UBound(arr, 2))
    On Error Resume Next
    For xx = 1 To UBound(arr, 2)
        For yy = 2 To UBound(arr, 1)
            brr(1, xx) = brr(1, xx) + arr(yy, xx)
        Next
    Next
    On Error GoTo 0
    Application.EnableEvents = False
    Cells(yy, 8).Resize(UBound(brr, 1), UBound(brr, 2)).Value = brr
    Application.EnableEvents = True
End Sub
Страницы: 1
Наверх