为一系列不断增加的单元格的最后一个单元格着色

时间:2017-10-26 20:59:55

标签: excel vba

我正在尝试创建一个宏,用于为高于前一个单元格的单元格着色。我想只对跟随一系列30个单元格的单元格进行着色,每个单元格高于前一个单元格。在这个截图中,如果我有这样的系列,只有E35应该是彩色的,因为从E5到E35,这30个单元中的每一个都严格高于它们的前一个(E35> E34> E33> ...>> E6> E5) 。

enter image description here

这是我试图做的代码:

Sub Consecutive_HigherCells()

Dim i, j As Integer

For i = 32 to 10000
For j = 1 To 30

    If Cells (i,5).Value > Cells(i-j,5).Value Then

    Cells(i, 5).Select

    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With

    End If

Next j
Next i

End Sub

实际上代码不能正常工作,因为当我运行它时,从E32到E1000的所有单元格都至少高于30个预先单元格中的一个单元格。

我真的需要你的帮助

3 个答案:

答案 0 :(得分:2)

Option explicit

Sub Consecutive_HigherCells()

Const LIMIT as long = 30

Dim i as long, j as long, Counter as long

For i = 32 to 10000

Counter = 0

For j = LIMIT to 1 step -1

If cells(i-j-1,"E").Value2 > cells(i-j,"E").value2 Then
Counter = counter + 1
Else
Exit for
End if

Next j

If counter = LIMIT then cells(i,"E").interior.color = rgb(255,255,0)

Next i

End Sub

未经测试并写在手机上,抱歉格式不正确。

答案 1 :(得分:1)

下面的代码将贯穿您的完整列表和颜色单元格,其中下一个序列的值较低

Sub HighlightCells30()
    Dim lr As Long, i As Long, count As Long
    count = 0
    lr = ActiveSheet.Range("E" & Rows.count).End(xlUp).Row
    For i = 5 To lr
        count = count + 1
        If Range("E" & i + 1).Value < Range("E" & i).Value Then
            If i <> lr And count > 30 Then
                Range("E" & i).Interior.Color = vbYellow
                count = 0
            End If
        End If
    Next i
End Sub

我没有完全了解30个批次试图实现的目标? 编辑:根据下面的Scotts说明更新了代码

答案 2 :(得分:0)

@Chillin&gt;谢谢你的帮助,你很亲密。我修改了你的代码,它现在正在运行。

Option Explicit

Sub Consecutive_HigherCells30()

Const LIMIT As Long = 30

Dim i As Long, j As Long, Counter As Long

For i = 32 To 10000

Counter = 0

For j = LIMIT To 1 Step -1

'If Cells(i - j - 1, "E").Value > Cells(i - j, "E").Value Then
If Cells(i - j - 1, "E").Value < Cells(i - j, "E").Value Then

Counter = Counter + 1
Else
Exit For
End If

Next j

If Counter = LIMIT Then Cells(i - 1, "E").Interior.Color = RGB(255, 255, 0)

Next i

End Sub