如何修复Excel VBA代码中的错误?

时间:2019-03-28 11:10:17

标签: excel vba

我想为不同的文本提供备用的背景色

我为此编写了一个代码,但有几个错误。我该如何改善?谢谢

enter image description here

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

1 个答案:

答案 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

enter image description here