Kuzmich, добрый день!
подпрограмма, что-то не заработала в таком виде и не добирается до кода Cells(n, "B") = iSumma
соответственно , ничего и не записывается в ячейки.
может проще поступить? и использовать If Cells(i + 1, "A") <> "" Then
или If Not IsEmpty(Cells(i, "A")) Then , но после проверки на наличие цвета в ячейке.
Код ниже работает...
подпрограмма, что-то не заработала в таком виде и не добирается до кода Cells(n, "B") = iSumma
соответственно , ничего и не записывается в ячейки.
может проще поступить? и использовать If Cells(i + 1, "A") <> "" Then
или If Not IsEmpty(Cells(i, "A")) Then , но после проверки на наличие цвета в ячейке.
Код ниже работает...
Код |
---|
Sub Sub Get_Kol_iRow()Dim i As LongDim iLastRow As LongDim iSummaDim iColIndex As LongDim n As IntegeriLastRow = Cells(Rows.Count, "A").End(xlUp).RowiColIndex = Cells(4, "A").Interior.ColorIndex iSumma = 0 n = 1 For i = 1 To iLastRow If Cells(i + 1, "A").Interior.ColorIndex <> iColIndex Then If Cells(i + 1, "A") <> "" Then iSumma = iSumma + 1 End If Else Cells(n, "D") = iSumma iSumma = 0 n = i + 1 End If Next MsgBox ("Выполнено") |
Код |
---|
End Sub |