Суммирование до разрыва строки - VBA
Формулировка задачи:
Доброго дня всем!
Столкнулся с задачей просуммировать ячейки в одном столбец до разрыва и сумму записать всего этого безобразия. (пример во вложении)
Поискав по ресурсам нашел два макроса которые делают примерно то, что мне надо.
и такой
но мозгов не хватает что бы его допилить под мое условие. Помогите плизз.
Заранее спасибо!
Листинг программы
- Sub sumCarN()
- Dim x As Range, sCell As Range, SumCar As Double
- For Each x In Range("a1:a" & ActiveSheet.UsedRange.Rows.Count)
- If Not IsEmpty(x) Then
- If Not sCell Is Nothing Then sCell = SumCar
- Set sCell = x.Offset(0, 2)
- SumCar = 0
- Else
- SumCar = SumCar + x.Offset(0, 1)
- End If
- Next
- End Sub
Листинг программы
- Sub mTOTAL()
- Dim cC As Range
- Application.ScreenUpdating = False
- With ActiveSheet
- .Cells(.Rows.Count, "a").End(xlUp).Offset(0, 1).Value = vbNullString
- For Each cC In .Columns("a:a").SpecialCells(xlCellTypeConstants)
- If cC.End(xlDown).Row < .Rows.Count Then
- cC.Offset(0, 2).Value = Application.Sum(Range(cC.Offset(1, 1), _
- cC.End(xlDown).Offset(-1, 1)).Value)
- .Cells(.Rows.Count, "a").End(xlUp).Offset(0, 1).Value = _
- .Cells(.Rows.Count, "a").End(xlUp).Offset(0, 1).Value + _
- CDbl(cC.Offset(0, 2).Value)
- End If
- Next ' cC
- End With
- Application.ScreenUpdating = True: MsgBox Space(10) & "D O N E!"
- End Sub
Решение задачи: «Суммирование до разрыва строки»
textual
Листинг программы
- Private Sub Test()
- Dim iSource As Range
- For Each iSource In Range("E:E").SpecialCells(xlConstants, xlNumbers).Areas
- iSource(0, 2) = Application.Sum(iSource)
- Next
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д