简体   繁体   中英

How to fix the error in the excel vba code?

I want to have alternate backgrd colour for different text

I wrote a code for it and there are several errors. How can I improve it? Thanks

在此处输入图片说明

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

I suggest the following code:

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

在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM