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

尝试一下，让我们知道是否适合您的要求。

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

Answer 2

我假设'R19：S33'是一个错字，而您实际上是说'R19：R33'。

onFileChanged(event) {
 console.log( event.target.files[0].name) );

在VBA循环中从右到左的彩色单元

2 个答案: