VBA Excel. Суммирование в одной ячейке и подсчёт событий

Ввод чисел и накопительное суммирование в одной и той же ячейке с помощью кода VBA Excel. Создание счётчика, учитывающего события Worksheet_Change.

Содержание

Суммирование в одной ячейке и счётчик

Стандартные формулы Excel не позволяют «накапливать» новые значения в той же ячейке, куда они вводятся. Для реализации сумматора в одной ячейке требуется использование кода VBA и события Worksheet_Change.

В этой статье мы рассмотрим два интересных решения на VBA Excel:

Ввод чисел и накопительное суммирование в одной и той же ячейке.
Код счётчика, учитывающего количество событий Worksheet_Change.

Ввод чисел и суммирование в одной ячейке

Исходный код VBA Excel

Этот код использует глобальную переменную уровня модуля PrevValue для хранения предыдущего значения ячейки A1. Скопируйте его и вставьте в модуль листа (не в стандартный модуль!).

Private PrevValue As Double

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Если изменилась не ячейка A1 - выходим из процедуры
    If Target.Address <> "$A$1" Then Exit Sub

    ' Проверяем, что введено число
    If Not IsNumeric(Target.Value) Then
        ' Возвращаем предыдущее значение
        Application.EnableEvents = False
            Target.Value = PrevValue
        Application.EnableEvents = True
        MsgBox "Пожалуйста, введите число!", vbExclamation, "Ошибка ввода"
        Exit Sub
    End If

    ' Запись суммы в A1
    Application.EnableEvents = False
        Target.Value = CDbl(Target.Value) + PrevValue
    Application.EnableEvents = True

    ' Обновляем предыдущее значение
    PrevValue = Target.Value
End Sub

' Процедура для тестирования:
Private Sub Test1()
Dim i As Byte
    For i = 1 To 10
        [A1] = 20
    Next
End Sub

Private PrevValue As Double

Private Sub Worksheet_Change(ByVal Target As Range)

' Если изменилась не ячейка A1 - выходим из процедуры

If Target.Address <> "$A$1" Then Exit Sub

' Проверяем, что введено число

If Not IsNumeric(Target.Value) Then

' Возвращаем предыдущее значение

Application.EnableEvents = False

Target.Value = PrevValue

Application.EnableEvents = True

MsgBox "Пожалуйста, введите число!", vbExclamation, "Ошибка ввода"

Exit Sub

End If

' Запись суммы в A1

Application.EnableEvents = False

Target.Value = CDbl(Target.Value) + PrevValue

Application.EnableEvents = True

' Обновляем предыдущее значение

PrevValue = Target.Value

End Sub

' Процедура для тестирования:

Private Sub Test1()

Dim i As Byte

For i = 1 To 10

[A1] = 20

End Sub

Как установить этот макрос?

Откройте файл Excel, в котором хотите использовать суммирование в одной ячейке.
Нажмите Alt + F11 – откроется редактор VBA.
В левом окне Project – VBAProject найдите ваш лист (например, Лист1) и дважды кликните по нему.
Скопируйте приведённый выше код и вставьте в открывшийся модуль листа.
Закройте редактор VBA и вернитесь в Excel.
Сохраните файл как Книга Excel с поддержкой макросов (*.xlsm), иначе макросы не будут работать.

Как это работает?

Переменная PrevValue – это переменная уровня модуля. Она сохраняет своё значение между вызовами события Worksheet_Change. В момент запуска книги её значение равно 0, если вы не добавили код, присваивающий ей начальное значение при открытии книги.
Excel вызывает событие Worksheet_Change каждый раз, когда пользователь (или другой макрос) меняет содержимое любой ячейки.
Мы ограничиваем макрос реакцией только на ячейку A1 с помощью условия If Target.Address <> "$A$1" Then Exit Sub.

Алгоритм

Новое значение, введённое пользователем или программой, записывается в ячейку A1 и связанную с ней переменную Target.
Проверяем, является ли значение числом. Если нет — восстанавливаем предыдущее значение из переменной PrevValue и выводим сообщение об ошибке.
Если введено число, временно отключаем события (Application.EnableEvents = False), чтобы при записи суммы обратно в A1 не запустить повторное событие Worksheet_Change.
Вычисляем сумму и записываем ее в ячейку A1: Target.Value = CDbl(Target.Value) + PrevValue.
Включаем события обратно (Application.EnableEvents = True).
Обновляем предыдущее значение (PrevValue = Target.Value).

Таким образом, при каждом вводе числа в ячейку A1, оно прибавляется к текущему итогу, а итог отображается в той же ячейке.

Тестирование

Для тестирования запустите процедуру Test1: в редакторе VBA установите курсор внутрь процедуры Test1 и нажмите F5.

Процедура Test1 выполняет цикл из 10 повторений, в каждом из которых в ячейку A1 программно записывается число 20. Что при этом произойдёт?

При первом присвоении [A1] = 20 переменная PrevValue равна 0 (по умолчанию), поэтому в ячейку A1 запишется 20, и PrevValue обновится до 20.
При втором присвоении 20 будет прибавлено к предыдущему значению 20, итог станет 40.
Третий шаг: 40 + 20 = 60 и так далее.
После 10 итераций в ячейке A1 окажется 200.

Важный момент

Процедура Test1 демонстрирует, что макрос работает не только при ручном вводе, но и при изменении ячейки из кода. Если вы хотите время от времени программно устанавливать новое начальное значение без суммирования, необходимо перед этим временно отключить события (Application.EnableEvents = False) и затем снова включить:

Sub ResetA1()
    Application.EnableEvents = False
        [A1] = 0
        PrevValue = 0
    Application.EnableEvents = True
End Sub

Sub ResetA1()

Application.EnableEvents = False

[A1] = 0

PrevValue = 0

Application.EnableEvents = True

End Sub

Счётчик количества событий Worksheet_Change

Теперь создадим счётчик событий Worksheet_Change, который увеличивается на 1 при любом изменении ячеек, кроме A1. В A1 будет записываться результат подсчёта.

Исходный код VBA Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Если изменён диапазон, отличный от A1 – увеличиваем счётчик
    If Target.Address <> "$A$1" Then
        [A1] = [A1] + 1
    End If
End Sub

' Процедура для демонстрации срабатываний
Private Sub Test2()
    Dim i As Byte
    
    ' 5 изменений в диапазоне A3:E3
    For i = 1 To 5
        Cells(3, i) = 15
    Next i
    
    ' 15 операций присвоения в ячейке A4
    For i = 1 To 15
        [A4] = 1
    Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

' Если изменён диапазон, отличный от A1 – увеличиваем счётчик

If Target.Address <> "$A$1" Then

[A1] = [A1] + 1

End If

End Sub

' Процедура для демонстрации срабатываний

Private Sub Test2()

Dim i As Byte

' 5 изменений в диапазоне A3:E3

For i = 1 To 5

Cells(3, i) = 15

Next i

' 15 операций присвоения в ячейке A4

For i = 1 To 15

[A4] = 1

Next i

End Sub

Тестирование

Процедура Test2 выполнит 20 присваиваний, каждое из которых вызовет событие Worksheet_Change. Поэтому после запуска в ячейке A1 должно оказаться 20, если, конечно, перед запуском было 0.

Счётчик событий в ячейке A1

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.