Пропуск клеток, которые окрашены

Question

У меня есть петля, где я хочу пропустить цветные ячейки.

For i = 1 To Count 
    Do While ActiveCell.Offset(0, i).Interior.ColorIndex = 15 
     i = i + 1: Count = Count + 1 
    Loop 

    With ActiveCell.Offset(0, i).Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent3 
     .TintAndShade = -0.249977111117893 
     .PatternTintAndShade = 0 
    End With 
Next i 

Это работает, однако начальная переменная счетчика не обновляется. Таким образом, если у меня есть 10 и есть 2 пропуски, значение i увеличивается, и это работает, но count остается на 10, хотя переменная говорит 12. Похоже, что увеличение переменной count не увеличивает цикл For. Я не могу принять 1 вдали от переменной i, потому что это приводит к тому, что на нее воздействует activecell.offset.

Answer 1

Зачем использовать .Offset? Это то, что вы пытаетесь? Таким образом, вы также можете пропускать цветные ячейки.

Dim col As Long, rw As Long, i As Long 

col = ActiveCell.Column 
rw = ActiveCell.Row 

For i = 1 To Count 
    With Cells(rw, col + i) 
     If .Interior.ColorIndex <> 15 Then 
      With .Interior 
       .Pattern = xlSolid 
       .PatternColorIndex = xlAutomatic 
       .ThemeColor = xlThemeColorAccent3 
       .TintAndShade = -0.249977111117893 
       .PatternTintAndShade = 0 
      End With 
     End If 
    End With 
Next i 

Answer 2

Возможно, очень неэффективный код, но их не так много. Помните, идея состоит в том, что столбец имеет дату, если этот столбец находится в субботу или воскресенье, то есть цвет серый, затем код должен пропускать эти ячейки и не вычитать их из общего счетчика.

If Not IsEmpty(y.Value) And IsNumeric(y.Value) And y.Value >= 7.5 Then 
With ActiveCell.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorAccent3 
    .TintAndShade = -0.249977111117893 
    .PatternTintAndShade = 0 
End With 
Col = y.Value - 7.5 
Col = Col/7.5 


Count = Left(Col, Len(Col) - InStr(1, Col, ".") + 1) 
y = 0 
For i = 1 To Count 


Do While ActiveCell.Offset(0, i).Interior.ColorIndex = 15 
ActiveCell.Offset(0, 1).Select 
y = y + 1 
Loop 
With ActiveCell.Offset(0, i).Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorAccent3 
    .TintAndShade = -0.249977111117893 
    .PatternTintAndShade = 0 
End With 
Next i 

ActiveCell.Offset(0, -y).Select 
ActiveCell.Offset(0, i + y).Select 
Do While ActiveCell.Interior.ColorIndex = 15 
ActiveCell.Offset(0, 1).Select 
Loop 
Co = Right(Col, Len(Col) - InStr(1, Col, ".")) 
If Len(Co) > 2 Then 
Co = Mid(Co, 1, InStr(1, Col, ".")) & "." & Mid(Co, InStr(1, Col, ".") + 1, Len(Co) - InStr(1, Col, ".")) 
End If 
If Co = 0 Then 
ElseIf Co >= 0.1 And Co <= 25 Then 
With ActiveCell.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorDark1 
    .TintAndShade = -4.99893185216834E-02 
    .PatternTintAndShade = 0 
End With 
ElseIf Co >= 26 And Co <= 49 Then 
With ActiveCell.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorAccent6 
    .TintAndShade = 0.799981688894314 
    .PatternTintAndShade = 0 
End With 
ElseIf Co >= 5 And Co <= 74 Then 
With ActiveCell.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorLight2 
    .TintAndShade = 0.799981688894314 
    .PatternTintAndShade = 0 
End With 
ElseIf Co >= 75 And Co <= 99 Then 
With ActiveCell.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorDark1 
    .TintAndShade = -4.99893185216834E-02 
    .PatternTintAndShade = 0 
End With 
End If 
End If 

Next y