автоматическое суммирование

[Артур Иваныч]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i%, j%
  Dim lLastCol As Long
    lLastCol = cells(9, Columns.Count).End(xlToLeft).Column
    
    Dim rFndRng As Range, lCol As Long
    Dim rFndRn As Range, rFnd As Range, rFndR As Range
    Set rFndRng = ActiveSheet.UsedRange.Find("ИТОГО", , xlValues, xlWhole)
    If rFndRng Is Nothing Then MsgBox "ИТОГО", vbInformation, "Отсутствует строка": Exit Sub
    
    Set rFndRn = ActiveSheet.UsedRange.Find("№ ИП", , xlValues, xlWhole)
    cells(rFndRn.Row, lLastCol) = 0
    For i = 10 To 11
        If cells(i, 2) Like "*ИП*" Then
        cells(rFndRng.Row, lLastCol) = cells(i, lLastCol)
            For j = i + 1 To rFndRng.Row - 1
                If cells(j, 2) Like "*ИП*" Then
                    cells(rFndRng.Row, lLastCol) _
                    = cells(rFndRng.Row, lLastCol) + cells(j, lLastCol)
                End If
            Next j
        End If
    Next i
    
    For i = 10 To rFndRng.Row
    If cells(i, 2) = "" Then
    lCol = cells(i, lLastCol).Row
    For j = rFndRn.Row To lCol
    cells(rFndRn.Row, lLastCol) = Application.Sum(Range(cells(rFndRn.Row + 1, lLastCol), cells(j, lLastCol)))
    Next j
    End If
    Next i
End Sub

всё считает
но только для первой фиолетовой строки
а как сделать для последующих
их ведь много может быть?

[Артур Иваныч]

вообще-то вот это лучше подходит для меня:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i%, j%
  Dim lLastCol As Long
    lLastCol = cells(9, Columns.Count).End(xlToLeft).Column
    
    Dim rFndRng As Range, lCol As Long
    Dim rFndRn As Range, rFnd As Range, rFndR As Range
    Set rFndRng = ActiveSheet.UsedRange.Find("ИТОГО", , xlValues, xlWhole)
    If rFndRng Is Nothing Then MsgBox "ИТОГО", vbInformation, "Отсутствует строка": Exit Sub
    
    Set rFndRn = ActiveSheet.UsedRange.Find("№ ИП", , xlValues, xlWhole)
    
    For i = 10 To rFndRng.Row
    If cells(i, 2) Like "*ИП*" Then
    
    cells(i, lLastCol) = cells(i + 1, lLastCol) + cells(i + j, lLastCol)
    
    End If
    Next i

НО как мне прописать переменную j
не знаю(((
Люди знающие помогите пожалуйсто..

[IgorGO]

Артур Иваныч, вы так категоричны к формулам...
А вы пробовали на примере присланном уважаемым The_Prist-ом пробовать добавить "оранжевых" строк положить в них данные, проверить сошлась ли сумма
Там приведено готовое, гибкое, рабочее решение...
А будете добавлять "фиолетувую" строку, просто скопируйте в новую в соответствующие ячейки формулы из предыдущей "фиолетовой" или в варианте, присланном мною, одну и ту же формулу.

[Артур Иваныч]

Да не работает же она((
вы сами попробуйте добавьте ещё жёлтые строки в любое место - формула не гибкое
и вообще мне нужен результат на листе,а не формулы
вот же код есть такой:

Dim i%, j%
  Dim lLastCol As Long
    lLastCol = cells(9, Columns.Count).End(xlToLeft).Column
    
    Dim rFndRng As Range, lCol As Long
    Dim rFndRn As Range, rFnd As Range, rFndR As Range
    Set rFndRng = ActiveSheet.UsedRange.Find("ИТОГО", , xlValues, xlWhole)
    If rFndRng Is Nothing Then MsgBox "ИТОГО", vbInformation, "Отсутствует строка": Exit Sub
    
    Set rFndRn = ActiveSheet.UsedRange.Find("№ ИП", , xlValues, xlWhole)
    
    For i = 10 To rFndRng.Row
    If cells(i, 2) Like "*ИП*" Then
    
    cells(i, lLastCol) = cells(i + 1, lLastCol) + cells(i + j, lLastCol)
    
    End If
    Next i

НО как задать цикл для j
не получается((

[The_Prist]

Сообщение от Артур Иваныч

Да не работает же она((
вы сами попробуйте добавьте ещё жёлтые строки в любое место - формула не гибкое

А у Вас автоматический пересчет формул включен? Или на ручном считаете? Попробуйте добавить строки и нажать Shift+F9.

[Артур Иваныч]

попробую
однако мне бы лучше вба((
я не могу переменной j задать так:
j = i +2 до тех пор пока цвет строки жёлтый(.Interior.ColorIndex = 36)
While или ещё какой цикл нужен...не знаю((сообразить никак не могу

[Артур Иваныч]

Уважаемый, The_Prist
я бы хотел у Вас уточнить 3 вещи:
1) Почему Вы не попробуете помочь мне сделать эту задачу через вба? разве это ОЧЕНЬ сложно...просто у меня не получается,но я пытаюсь - может напрасно? может на самом деле это невозможно сделать на вба?
2) у меня нет автоматический пересчет формул, и шифт и ф9 е помогает, что делать? как включить его
3) как эту громосткую формулу вписать в вба?

[Артур Иваныч]

у меня по умолчанию включён автоматический пересчёт формул
однако Ваш пример не работает
я удаляю жёлттые строки - всё норм, обновляется, пересчитывается
а если добавляю - НЕ работает((

[The_Prist]

Сообщение от Артур Иваныч

Уважаемый, The_Prist
я бы хотел у Вас уточнить 3 вещи:
1) Почему Вы не попробуете помочь мне сделать эту задачу через вба? разве это ОЧЕНЬ сложно...просто у меня не получается,но я пытаюсь - может напрасно? может на самом деле это невозможно сделать на вба?
2) у меня нет автоматический пересчет формул, и шифт и ф9 е помогает, что делать? как включить его
3) как эту громосткую формулу вписать в вба?

1. Возможно. Но я не понимаю на чем надо основываться, куда и как у Вас что будет добавляться. Фиолетовые, желтые, оранжевые....Фиолетовые расширяются... Если б я более-менее понимал алгоритм добавления всех строк - то да, я бы написал Вам код. А так - трата времени. Все равно потом окажется, что все не так, а надо было вот эдак.
2. Shift+F9 просто пересчитывает все формулы на листе. Разово.
3. Элементарно. Просто записываете макрорекордером вставку этой формлы в ячейку.

P.S.Если Вам нужен разовый пример и Вы в состоянии его переделать под себя - я выложу Вам код суммирования по тому алгоритму, который я представляю себе.

[Артур Иваныч]

я вам всё таки выложу полноценный файл
и поймёте что к чему
и зачем именно в вба нужно