Как исправить ошибку в коде Excel VBA? - PullRequest
0 голосов
/ 28 марта 2019

Я хочу иметь альтернативный цвет фона для другого текста

Я написал код для него, и есть несколько ошибок. Как я могу улучшить это? Спасибо

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 Ответ

3 голосов
/ 28 марта 2019

Предлагаю следующий код:

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...