Ячейка с накоплением (нарастающим итогом)

Достаточно часто возникает ситуация, когда нам необходимо суммировать (накапливать) несколько последовательно введенных в одну ячейку значений:

accumulator-cell.gif

Т.е. если, например, ввести в ячейку А1 число 5, то в B1 должно появиться число 15. Если затем ввести в А1 число 7, то в ячейке B1 должно появится 22 и т.д. Вобщем то, что бухгалтеры (и не только они) называют накопительный итог.

Реализовать такую накопительную ячейку-аккумулятор можно при помощи простого макроса. Щелкните правой кнопкой мыши по ярлычку листа, где находятся ячейки А1 и B1 и выберите в контекстном меню Исходный текст (Source Code). В открывшееся окно редактора Visual Basic скопируйте и вставьте код простого макроса:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      With Target
         If .Address(False, False) = "A1" Then
            If IsNumeric(.Value) Then
               Application.EnableEvents = False
               Range("A2").Value = Range("A2").Value + .Value
               Application.EnableEvents = True
            End If
         End If
      End With
End Sub

Адреса ячеек А1 и A2, естественно, можно заменить на свои.

Если отслеживать ввод данных и суммировать нужно не отдельные ячейки, а целые диапазоны, то макрос придется немного изменить:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        If IsNumeric(Target.Value) Then
            Application.EnableEvents = False
            Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
            Application.EnableEvents = True
        End If
    End If
End Sub

Предполагается, что ввод данных производится в ячейки диапазона A1:A10, а суммируются введенные числа в соседний столбец справа. Если в вашем случае он не соседний, то увеличьте сдвиг вправо в операторе Offset - замените 1 на число побольше.

Ссылки по теме



Андрей
07.10.2012 14:29:11
Всё великолепно, только у меня маленькая просьба, модернизации этого маркоса.
Ячеек для ввода данных несколько, в столбик, а ячейка для накопления данных одна. Как так сделать?.
07.10.2012 14:33:21
Замените строку
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value

на
range("B1").Value = range("B1").Value + Target.Value

где B1 - ваша одна ячейка накопления
Роман
07.10.2012 14:29:37
Спасибо большое за данный прием!!! Очень нужен был!!!
01.02.2013 09:58:05
Николай, спасибо большое, отличная вещь!!! Ваш сайт - просто какой-то драгоценный клад для "свихнутых" на Excel! :)
12.08.2016 15:02:57
Это точно ! :)
05.02.2013 11:54:35
Не подскажете, что я делаю не так? Нужно сделать накопительными два столбца подряд, в которые попадают данные также из двух столбцов, расположенных рядом. Накопительные сдвинуты на 3 столбца вправо. Первый макрос срабатывает, а второй не хочет - ни в одном окне макроса, ни в разных...
Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Target, Range("I6:I100" )) Is Nothing Then
     If IsNumeric(Target.Value) Then
      Application.EnableEvents = False
      Target.Offset(0, 3).Value = Target.Offset(0, 3).Value + Target.Value
      Application.EnableEvents = True
     End If
    End If
End Sub

Sub Worksheet_Change(ByVal Target As Excel.Range)
 If Not Intersect(Target, Range("J6:J100" )) Is Nothing Then
 If IsNumeric(Target.Value) Then
 Application.EnableEvents = False
 Target.Offset(0, 3).Value = Target.Offset(0, 3).Value + Target.Value
 Application.EnableEvents = True
 End If
 End If
End Sub 
07.02.2013 00:47:20
Лилия, процедура Worksheet_Change бывает только одна, а у вас две (да еще и с одинаковым именем) - поэтому вторая не выполняется. Нужно объединить код этих двух макросов в один. Да и не нужна тут вторая половина - достаточно увеличить чувствительный интервал:
Sub Worksheet_Change(ByVal Target As Excel.Range)
     If Not Intersect(Target, Range("I6:J100" )) Is Nothing Then
            If IsNumeric(Target.Value) Then
           Application.EnableEvents = False
           Target.Offset(0, 3).Value = Target.Offset(0, 3).Value + Target.Value
           Application.EnableEvents = True
           End If
        End If
End Sub
07.02.2013 09:01:48
Николай, спасибо Вам огромное!!! Вроде всё просто, а вот не додумалась же! :)
А как оформляются несколько разных процедур, если в интервал попадают столбцы, которые не нужны для накопления? Например, из столбца I перенести на 3, а из столбца K (через один) на 5. Заранее прошу прощения за излишнее любопытство, но очень хочется освоить этот прием до конца ;)
19.04.2013 21:42:15
Я бы рекомендовал для каждого диапазона прописывал свой блок If Not Intersect... End If внутри одной общей процедуры обработки события Sub... End Sub
Будет немного громоздко, но зато не запутаетесь.
22.04.2013 08:54:10
Спасибо большое!
19.04.2013 19:23:39
Подскажите пожалуйста как быть, данный макрос у меня не работает, если в ячейку ввода данных подтягиваются данные из другой таблицы, или же просто если в ячейке ввода данных есть формула (сумма и т.д.) т.е. макрос работает только если в ячейку ввода данных вводить данные только вручную, это не очень удобно... Спасибо заранее
19.04.2013 21:47:26
Если у вас в ячейке ввода данных формула, то когда вы собираетесь плюсовать ее данные к накопительной ячейке? При каждом пересчете листа? Это при любом изменении любой ячейки файла происходит, т.е. сотни раз в минуту.
Если нужно плюсовать только при изменении результата формулы после пересчета, то придется в макросе где-то хранить предыдущее значение и при каждом пересчете сравнивать новое значение со старым. И плюсовать только в том случае, если оно изменилось.
22.04.2013 09:30:30
Вы правильно заметили, плюсовать нужно именно при изменении результата формулы после пересчета. Допустим в нескольких столбцах, в одной строке постоянно меняются данные, например добавляются единицы, потом есть суммирующая ячейка, но когда в этих ячейках данные обнуляются, суммирующая ячейка тоже обнуляется, поэтому нужна ячейка с накоплением результата. К сожалению решение найти не смог. Подскажите пожалуйста как реализовать Ваше предложение хранить в макросе предыдущее значение и затем плюсовать его... Спасибо заранее..
26.04.2013 05:27:41
Потрясающе! То что нада. Огромное спасибо!
12.06.2013 21:43:06
Подскажите пожалуйста, возможно ли сделать так, чтобы данные вводились в ячейки столбцов A:B:C, а накопительный итог был в одном столбце? Спасибо.  
20.06.2013 17:51:14
Добрый день! Подскажите, а можно ли этот макрос изменить так, чтоб он работал не с числами, а с текстом? То есть, чтоб текст из ячейки ввода данных добавлялся к тексту, который уже имеется в ячейке накопления данных.
Спасибо.
02.07.2013 10:15:04
Просто замените в коде знак + на &
26.07.2013 15:55:11
Кроме того, насколько я понимаю, нужно заменить функцию IsNumeric.
25.09.2013 14:55:54
Да, просто убрать строчку с ней.
07.08.2013 07:42:12
Sub Worksheet_Change
(ByVal Target As Excel.Range)     
If Not Intersect(Target, Range("I6:J100" )) Is Nothing Then   
   If IsNumeric(Target.Value) Then     
   Application.EnableEvents = False  
   Target.Offset(0, 3).Value = Target.Offset(0, 3).Value + Target.Value     
   Application.EnableEvents = True     
   End If     
End If
End Sub 
Николай! Бьюсь вторую неделю, не могу реализовать эту функцию в Userform. Суть задачи в том, чтобы при последовательном выборе значений из списка комбобокса значения, выбираемые в комбобоксе  накапливались либо в ячейке на листе, либо в текстбоксе - хоть где -нибудь:(. Заранее благодарен за возможную помощь или комментарий.
14.09.2013 14:09:37
Добрый день. А может и мне поможете.Мне надо этот макрос применить на несколько ячеек в разных местах странице.Подскажите что куда надо добавить.
04.10.2013 10:23:43
Добрый день. Используя всё вышеизложенное получилось сделать ячейку G2, в которой суммируются данные вводимые в диапазон A2;F2.


"Private Sub Worksheet_Change(ByVal Target As Excel.Range)

   If Not Intersect(Target, Range("A2:F2")) Is Nothing Then
       If IsNumeric(Target.Value) Then
           Application.EnableEvents = False
           Range("G2").Value = Range("G2").Value + Target.Value
           Application.EnableEvents = True
       End If
   End If
End Sub"

Подскажите, пожалуйста, как сделать неограниченное количество таких строк?  
08.10.2013 13:31:13
Каких строк? Ячеек?
09.10.2013 08:34:46
Да, ячеек, но в каждой последующей строке. Т.е. диапазон А3;F3 будет суммироваться в G3, А4;F4 в G4 и т.д.
Хотим сделать книгу контроля наличия запчастей на складе. Листов в книге будет 32, в листах с 1 по 31 - столбцы диапазона А;F будут соответствовать подразделениям получающим запчасти, каждая строка - определённой детали. Листы все одинаковые, данные из столбцов G будут суммироваться на листе 32. Туда же, на 32 лист будут забиваться данные об остатках с прошлого месяца и о поступлениях запчастей, в результате будет видно наличие той или иной запчасти на данный момент. Вот такая задумка. Получится ли?
09.10.2013 08:40:26
Можно так:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 
  If Not Intersect(Target, Range("A3:F10")) Is Nothing Then
     If IsNumeric(Target.Value) Then
         Application.EnableEvents = False
         Cells(Target.Row, 7).Value = Cells(Target.Row, 7).Value + Target.Value
         Application.EnableEvents = True
     End If
  End If
End Sub


Сергей, а чем вам, в данном случае, обычные формулы не подходят? Прописать в G3 формулу =СУММ(A3:F3) и скопировать вниз, я имею ввиду.
09.10.2013 10:13:50
Спасибо большое, Николай, за помощь! Надеюсь теперь получится.
По поводу простых формул, дело в том, что отдельные подразделения в период ремонта могут брать, например болтов М10, по несколько раз за день. Будет надёжней если суммировать будет Ексель, а не Джамшут.
И ещё вопрос - при появлении новых запчастей придётся в каждый лист, в определённое место, добавлять новую строку с наименованием. Возможно ли это автоматизировать? Например добавил в 32 лист - появилась в остальных? Или это отдельная тема? Архив форума просмотрел до 40 страницы, пока не нашёл. Впереди ещё 1000 с лишним.
09.10.2013 10:14:12
Ну, это совсем просто
Сначала выделите все листы (удерживая CTRL или SHIFT щелкаете по ярлычкам листов), а потом вводите новые данные на один из них - они добавятся на все.
09.10.2013 11:13:58
Действительно, просто. Ещё раз спасибо, Николай!
15.10.2013 02:36:43
добрый день,

есть вопрос о ячейке с накоплением через н-ую строчку. Напр. столбик А - ячейка A10 - 1-я, 4-я и 7-я и ячейка A11 - 2-я, 5-я и 8-я строчки, т.е. через каждую 3-ю строчку. Cтолбик B описывается таким кодом

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("B1:B7")) Is Nothing And IsNumeric(Target) Then
       Application.EnableEvents = False
             Range("B10") = Range("B10").Value + Target.Value
       Application.EnableEvents = True
   End If
End Sub 
Спасибо :)
28.10.2013 19:59:19
Николай, спасибо за замечательный макрос! Но вот одна проблемка: с некоторой периодичностью данные в столбце ввода [ Target, Range("O7 : O5000" )  ] меняются при помощи формулы (которая тянет новые данные для каждой строки по условиям из другого файла). Формула эта храниться как формула только в одной ячейке выше шапки, а в остальных после обновления данных сохраняется как значение (для экономии ресурсов). НО при вставлени формулы в поля ввода, в полях накопления ничего не происходит (вставляются формулы диапазоном), и при Ctrl+C - Ctrl+V(as value) тоже ничего.
Однако, если взять поштучно, т.е. скопировать формулу и вставить в ОДНО поле ввода данных (для их соответ-го обновления), то поле накопления корректно меняется. Но строк-то более 500 - в каждую руками всталять долго.
А также, если после вставки формулы в поле ввода данных нажать F2 и Ввод, то поле накопления также корректно меняется.
ВОПРОС: что необходимо сделать, чтобы поле накопления менялось и после вставки в поле ввода формулы (без проваливания в каждую по F2) ?? - ооочень нужно, помогите пожалуйста.
Исходный код такой:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

   If Not Intersect(Target, Range("o7:o5000";)) Is Nothing Then

 If IsNumeric(Target.Value) Then

Application.EnableEvents = False

Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target
Application.EnableEvents = True

 End If

   End If

End Sub

02.03.2014 10:00:11
здравствуйте Николай
макрос работает великолепно, спасибо за Ваши подсказки.
помогите  пожалуйста когда ввожу данные на А1, на А2 накапливается, замечательно. как можно сделать так, когда вводишь например данные  на B1, из сумм накопленных на А2 минусовалось. Вводя данные на А1 и на В1 по очередности хотелось бы увидеть результат на А2. Ячейка А2 находится на другом листе.
28.05.2014 15:03:16
Здравствуйте Николай!
Подскажите пожалуйста как запрограммировать макрос так  что бы данные забивались в одной рабочей книге excel  а суммировались в другой? Я только учусь работать с макросами и пока не очень хорошо разбираюсь. Помогите, буду вам очень благодарен!
09.02.2015 17:23:44
Добрый день Николай!
Спасибо за макрос! Возможно ли сделать чтобы данный макрос срабатывал не автоматически, а  например при нажатии кнопки(либо другой команды на выполнение)?
14.02.2015 11:18:48
С этим проще - надо просто не помещать макрос в обработчик события изменения листа, а прописать как обычный:
Sub Plusovalka()
   Range("A2") = Range("A2") + Range("A1")
End Sub
 
Потом можно нарисовать на листе кнопку (вкладка Разработчик - Вставить - Кнопка) и назначить ей этот макрос.  
14.02.2015 18:21:55
СПАСИБО!:D
13.02.2015 21:28:59
Большое спасибо! Но как быть если надо несколько накопительных ячеек на одном листе?
14.02.2015 11:23:09
Прописать их все внутри макроса, как в первом примере:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      With Target
         If .Address(False, False) = "A1" Then
             ....
         End If
         If .Address(False, False) = "F5" Then
             ....
         End If
         If .Address(False, False) = "X13" Then
             ....
         End If
      End With
End Sub
 
19.02.2015 17:53:19
Здравствуйте, Николай.

Мои познания VBA ограничены макрорекордером и, иногда, методом "научного тыка". Когда первым способом решить задачу невозможно, а второй не помогает, я вынужден обращаться за помощью. Поэтому я очень прошу Вас каждую строку макроса расписать, чтобы понимать как он работает? Например:

Private Sub Worksheet_Change(ByVal Target As Excel.Range) ' строка для контроля изменений на рабочем листе: 
' Private Sub (делает то-то) Worksheet_Change (следит за изменениями) (ByVal Target As Excel.Range) (отвечает за то-то)
      
 
И дальше в том же духе.
Для наглядности: есть макрос
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim a
a = Array("$P$11", "$P$13", "$P$15", "$P$17", "$P$19", "$P$21", "$P$23", "$P$25", "$P$26")  
For i = 0 To UBound(a)
If Target.Address Like "*" & a(i) & "" Then
    With Target
      Application.EnableEvents = False
      .Offset(, -2) = .Offset(, -2) + .Value
      .Offset(, -4) = .Offset(, -4) + .Value
      Application.EnableEvents = True
    End With
    Exit For
End If
Next
End Sub
 
он работает для суммирования нарастающим итогом в ячейках столбцов L и N значений, вводимых в ячейки столбца P. Сейчас требования изменились и мне нужно, чтобы сумма нарастающим итогом считалась еще и в ячейках столбцов S и U для значений, вводимых в ячейки столбца W. Как мне реализовать желаемое?

Спасибо
Спасибо!!!
Первый раз сегодня попробовал работу с макросом и сразу удача!!!
Особенно пост от 14 февраля 2015 года.
Именно то что нужно...
Спасибо огромное!!!
18.05.2015 14:20:29
Добрый день, а подскажите как добавить несколько разных диапазонов с разными ячейками сложения на одном и том же листе, что то не соображу никак, как дополнить второй макрос.
29.07.2015 17:26:52
Здравствуйте, пишу Вам в первые.
Ни как не пойму где "исходный текст"
Помогите реализовать такой вариант, надо в ячейку вложить все значения, по всем листам, где строка равняется значению ссылки на ячейку на отдельном листе. Может стоит разделить на файлы, а потом вводить макрос?
31.07.2015 22:38:03
Попробую переформульровать: в пределах файла связи между листами надо находить значение на против связи, в другом столбце и складывать в указанную ячейку так просуммировать где одинаковые связи
02.08.2015 13:59:54
Николай, добрый день!

Я не смог решить такую задачу, помогите, пожалуйста: в умной таблице в одной колонке содержаться числовые данные, которые постоянно обновляются, а в другой колонке, имеющей процентный формат, необходимо реализовать отображение нарастающего итога. При этом этот нарастающий итог должен сам определять минимальное значение в исходном столбце вне зависимости от сортировки этого столбца.

Если есть решение попроще в виде какой-нибудь формулы, было бы здорово его применить. С макросами не дружу, поскольку являюсь простым пользователем. Если без макроса никак, то ничего, освою. Задача того требует.

Спасибо большое.
04.05.2016 18:00:32
А как отменить действие макроса на ход назад если ввел неправильно данные в ячейку для ввода данных ? Может кто знает
08.08.2016 12:23:25
Добрый день , подскажите , не как не могу разобраться , вставлю код что бы было понятнее ,                                                                                                      Private Sub Worksheet_Change(ByVal Target As Excel.Range)

   If Not Intersect(Target, Range("T7:T69:W7:W69")) Is Nothing Then
       If IsNumeric(Target.Value) Then
                Application.EnableEvents = False
           Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
           Application.EnableEvents = True
        End If
        End If
   End Sub      
Вот такая петрушка получилась , работает если цифры водить в ручную , но в данных ячейках  T7:T69:W7:W69" , они обновляются по формуле с других формула простая =G2 .  И когда обновляются они то макрос не складывает данные числа , если нажать на ячейку и потом энтер , после этого складывает , что можно и нужно подправить в данном коде.
30.09.2016 16:34:13
Николай, добрый день, а если накапливающийся столбик слева, Необходимо строчку  Target.Offset(0, -2).Value = Target.Offset(0, -2) исправить на Target.Offset(0, -2).Value = Target.Offset(0, -2). И как быть если в прибавляемой ячейке данные это результат формулы
24.11.2016 13:15:15
Николай, добрый день!
Подскажите как реализовать макрос.
Необходимо только на текущем листе где 1000 строк (примерно) при нажатии на кнопку макроса
Все значения ячеек F добавить к значениям ячеек E через "; " (точка с запятой и пробел)
Я пробовал как описано в посте выше
http://www.planetaexcel.ru/techniques/3/52/#1646
у меня при начале работы над макросом ругается на строку
Target.Offset(0, 3).Value = Target.Offset(0, 3).Value & Target.Value    
Подскажите как реализовать макрос!?
28.03.2017 10:58:52
Добрый день Николай! Спасибо большое за ваш труд!
07.04.2017 08:39:29
Добрый день. А как можно перенести этот скрипт в Google Docs Excel? Или как данный функционал можно реализовать ? Нигде ничего не могу найти. При загрузке Exel документа макрос не переносится.
27.02.2018 14:59:26
Здравствуйте! Есть табличка в столбец А вводятся числа, а в столбце В они суммируются, так, что при вводе каждого нового в А в В отображается накопительный итог:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   With Target
 If .Column = 1 Then
If IsNumeric(.Value) Then
   Application.EnableEvents = False
   .Offset(0, 1).Value = .Offset(0, 1).Value + .Value
   Application.EnableEvents = True
End If
 End If
   End With
End Sub
Возможно ли так, что бы в столбце А в каждой ячейке тоже суммировались вводимые числа
03.04.2018 04:34:03
Спасибо за решение.
Но вот в чем проблема, нет накопления при смене числа, если число меняется через команду "СЛУЧМЕЖДУ". Если я делаю один пересчет с помощью клавиши F9. Хотя казалось бы должно увеличиваться, можете мне в этом помочь?
04.04.2018 14:37:34
Доброго дня , прошу прощения за беспокойство , подскажите пожалуйста как сделать так что бы несколько таких столбцов появилось ?

Примеру в а столбце данные (В) суммирует затем допустим С столбец данные а столбец (D) cуммирует ?
14.07.2018 21:45:12
Всем привет, долго искал похожую тему.... все что описано выше понятно, но у меня другая проблема. В приложении пример. У меня есть техника, статус D6 (Работа / Ремонт / Ожидание запчастей) который меняется на ежедневной основе. Подскажите как сделать накопительный свод, к примеру 14/07/2018 статус автомобиля Носом прицеп (Работа) - > данные автоматический вносятся в календарь (вкладка календарь) на 14/07/2018 (Работа). 15/07/2018 статус этого автомобиля (Ремонт) - > данные автоматический вносятся в календарь (вкладка календарь) на 15/07/2018 (Ремонт). При этом данные за 14/07/2017 сохранены на дату 14/07/2018.

Спасибо за помощь.
Приме
22.02.2019 14:43:43
Спасибо за решение вопроса. Ваш сайт очень помогает
Наверх