我想为不同的文本提供备用的背景色
我为此编写了一个代码,但有几个错误。我该如何改善?谢谢
Sub Alternatecolour()
Flag = True
lr = Cells(Rows.Count, 1).End(xlUp).Row
Startcl = Cells(2, "D")
For Each cl In Range("D2:D" & lr)
str1 = cl.Text
str2 = cl.Offset(-1, 0).Text
Diff = StrComp(str1, str2, vbBinaryCompare)
If Diff = 0 Then
GoTo Loopend
End If
If Diff <> 0 Then
If Flag = True Then
Range(Startcl, cl).Interior.Color = 15
Startcl = cl
Flag = False
Else
Range(Startcl, cl).Interior.Color = 16
Startcl = cl
Flag = True
End If
End If
Loopend
Next cl
End Sub
答案 0 :(得分:3)
我建议使用以下代码:
Public Sub AlternateColor()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("ColorMe")
Dim ColorRange As Range
Set ColorRange = ws.Range("D2", ws.Cells(ws.Rows.Count, "D").End(xlUp))
Dim StartRow As Long
StartRow = ColorRange.Row
Dim ActColor As Long
ActColor = 15
Dim iRow As Long
For iRow = ColorRange.Row To ColorRange.Rows.Count + ColorRange.Row - 1
If ws.Cells(iRow, "D").Value <> ws.Cells(iRow, "D").Offset(1, 0).Value Then
ws.Range(ws.Cells(StartRow, "D"), ws.Cells(iRow, "D")).Interior.ColorIndex = ActColor
ActColor = IIf(ActColor = 15, 16, 15)
StartRow = iRow + 1
End If
Next iRow
End Sub