Цвет клеток справа налево в цикле VBA

Question

Попытка создать цикл, который начинается с выбора диапазона T17: T35 и окрашивания его в желтый RGB (255, 235, 59).

Затем цикл влево, добавление счетчика 1 к вершине и удаление 1снизу для каждого столбца, пока нет ячеек для окраски.

Sub Smile()

Dim Counter As Integer
Dim Column As Integer
Dim Row As Integer

Counter = 18
Row = 18
Column = 20

Worksheets("Sheet1").Range("A:BB").ColumnWidth = 1.25
Worksheets("Sheet1").Range("1:200").RowHeight = 8
Worksheets("Sheet1").Range("A1:BB200").Interior.Color = RGB(135, 206, 235)
Worksheets("Sheet1").Range("U16:AA56").Interior.Color = RGB(255, 235, 59)
'Worksheets("Sheet1").(R[17]C[20]).Interior.Color = RGB(255, 235, 59)
Worksheets("Sheet1").Range("T17:T56").Interior.Color = RGB(255, 235, 59) 'Example Row 1
Worksheets("Sheet1").Range("S18:S55").Interior.Color = RGB(255, 235, 59) 'Example Row 2
Worksheets("Sheet1").Range("R19:R54").Interior.Color = RGB(255, 235, 59) 'Example Row 3

'Do While Counter > 0
'    Worksheet.Range(R[Row]C[Column]:T" & Counter + 18).Interior.Color = RGB(255, 235, 59)
'    Counter -1
'Loop
End Sub

Строки в коде с комментариями Пример Строка 1, Пример Строка 2, Пример Строка 3 - начало того, чего я хочу достичьв цикле, пока разница в диапазоне между начальной и конечной точками не станет 0.

Answer 1

Я предполагаю, что 'R19: S33' была опечаткой, и вы действительно имели в виду 'R19: R33' .

Dim i As Long, ext As Long, srng As Range

With Worksheets("Sheet1")
    .Range("A:BB").ColumnWidth = 1.25
    .Range("1:200").RowHeight = 8
    .Range("A1:BB200").Interior.Color = RGB(135, 206, 235)
    .Range("U16:AA56").Interior.Color = RGB(255, 235, 59)
    Set srng = .Cells(17, "T")      'start at T17
    ext = 19                        'start with 19 rows
    For i = 0 To ext Step 2
        srng.Offset(i / 2, -i / 2).Resize(ext - i, 1).Interior.Color = RGB(255, 235, 59)
    Next i
End With

Answer 2

Попробуйте и дайте нам знать, если это соответствует вашему запросу.

Option Explicit

Sub colorss()
    Dim R1 As Range: Set R1 = Range("T17:T35")

    Do While R1.Count > 1
        R1.Interior.Color = RGB(255, 235, 59)
        If R1.Count = 2 Then
            Set R1 = R1.Offset(1, -1).Resize(1, 1)
        Else
            Set R1 = R1.Offset(1, -1).Resize(R1.Count - 2, 1)
        End If
    Loop

End Sub

РЕДАКТИРОВАТЬ

Другая версия, в которой не хватает последней ячейки для нечетных начальных значений

Option Explicit

Sub colorss()
    Dim R1 As Range: Set R1 = Range("T17:T35")
    R1.Interior.Color = RGB(255, 235, 59)
    Do While R1.Count > 2
        Set R1 = R1.Offset(1, -1).Resize(R1.Count - 2, 1)
        R1.Interior.Color = RGB(255, 235, 59)
    Loop
End Sub