Цикл

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

Здравствуйте ВСЕМ!
имеется цикл:

For i = 10 To rFndRng.Row
        If cells(i, 2) Like "*ИП*" Then
        'j = 2
            'While j = cell.Interior.ColorIndex = 36
                cells(i, lLastCol) = cells(i + 1, lLastCol) + cells(i + j, lLastCol)
            'Wend
        End If
    Next i

Вопрос: j должен быть от 2ух до тех пор пока строка жёлтая ну или до тех пор пока не началась строка cells(i, 2) Like "*ИП*"(фиолетовая)
как организовать цикл, с помощью чего?
заранее спасибо!!!

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

вот более точная:

Private Sub CommandButton1_Click()
    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)

    Set rFndRn = ActiveSheet.UsedRange.Find("№ ИП", , xlValues, xlWhole)
    
    Dim Col As Long, ii%, jj%, llCol As Long, k%
    For ii = 10 To rFndRng.Row
    If cells(ii, 2) Like "*ИП*" Then
    cells(ii, lLastCol) = cells(ii + 1, lLastCol)
    
    For jj = 2 To 3
    
    cells(ii, lLastCol) = cells(ii, lLastCol) + cells(ii + jj, lLastCol)

    Next jj
    End If
    Next ii
End Sub

но вместо j=2 to 3 нужно вместо 3 такую переменную до до тех пор пока строка жёлтая ну или до тех пор пока не началась строка cells(i, 2) Like "*ИП*"(фиолетовая)

[Xpoft]

Попробуйте организовать цикл который посчитает необходимое вам jj
Что то вроде того:
For ii = 10 To rFndRng.Row
If cells(ii, 2) Like "*ИП*" Then
cells(ii, lLastCol) = cells(ii + 1, lLastCol)
CountJJ = 0
Do while cells(ii+CountJJ+2,lLastCol).interi or.color = ...
CountJJ = CountJJ+1
loop
For jj = 2 To CountJJ

cells(ii, lLastCol) = cells(ii, lLastCol) + cells(ii + jj, lLastCol)

Next jj
End If
Next ii

[EducatedFool]

Private Sub CommandButton1_Click()
    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)

    Set rFndRn = ActiveSheet.UsedRange.Find("№ ИП", , xlValues, xlWhole)

    Dim Col As Long, ii%, jj%, llCol As Long, k%
    For ii = 10 To rFndRng.Row
        If Cells(ii, 2) Like "*ИП*" Then
            Cells(ii, lLastCol) = Cells(ii + 1, lLastCol)

            jj = 2
            While Cells(ii + jj, lLastCol).Interior.ColorIndex = 36
                Cells(ii, lLastCol) = Cells(ii, lLastCol) + Cells(ii + jj, lLastCol)
                jj = jj + 1
            Wend

        End If
    Next ii
End Sub

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

БОЛЬШОЕ спасибо!