Mail.ruПочтаМой МирОдноклассникиВКонтактеИгрыЗнакомстваНовостиКалендарьОблакоЗаметкиВсе проекты

Помогите написать макрос Exel

Михаил Ворнов Знаток (326), закрыт 2 недели назад
Нужно чтобы суммировались все значения ячеек А. Сумма должна выводиться через одну пустую ячейку. В эту пустую ячейку должна быть возможность вписать новое значение. Если добавить новое значение, то ячейка со старой суммой должна очиститься и должна посчитать новая сумма с учетом добавленного значения. Новая сумма должна быть записана через пустую ячейку

Ниже блок кода, который я пытался сделать через нейросети, но он работает криво
 Private Sub Worksheet_Change(ByVal Target As Range) 
' Проверяем, изменилась ли ячейка в столбце A
If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
' Отключаем события, чтобы избежать повторного вызова
Application.EnableEvents = False
' Выполняем расчет и запись суммы
Call UpdateSum
' Включаем события обратно
Application.EnableEvents = True
End If
End Sub

Sub UpdateSum()
Dim ws As Worksheet
Dim lastRow As Long
Dim sumRange As Range
Dim totalCell As Range
Dim sumRow As Long
Dim previousSumRow As Long

' Установить активный лист
Set ws = ActiveSheet

' Найти последнюю заполненную ячейку в столбце A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Установить диапазон для суммирования
Set sumRange = ws.Range("A1:A" & lastRow)

' Найти строку, где будет находиться сумма
sumRow = lastRow + 2

' Найти предыдущую строку с суммой, если она есть
On Error Resume Next
previousSumRow = ws.Cells.Find(What:="*", After:=ws.Cells(1, "A"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
On Error GoTo 0

' Проверить, если предыдущая строка с суммой существует
If previousSumRow > 1 And IsNumeric(ws.Cells(previousSumRow - 1, "A").Value) Then
ws.Cells(previousSumRow - 1, "A").ClearContents
End If

' Записать сумму в ячейку через одну пустую строку ниже последнего значения
Set totalCell = ws.Cells(sumRow, "A")
totalCell.Value = Application.Sum(sumRange)

' Опционально: отформатировать ячейку с суммой
With totalCell
.Font.Bold = True
.NumberFormat = "#,##0.00" ' Форматирование числа
End With
End Sub
Лучший ответ
Abram Pupkin Мудрец (18872) 1 месяц назад
скажите: а макрос - это обязательное условие ?
Этот же результат, но на формулах :
Клик на ячейку "А2" - закрепить области.
это позволит видеть и результат(A1) и конец таблицы одновременно
 =СУММ(A2:A9999) 
В любое время таблицу можно дописывать до 9998 слагаемых.
Остальные ответы
Похожие вопросы