Разные цвета для каждой ячейки в диапазоне

Question

Мне нужна помощь, мне нужен мой макрос, чтобы закрасить каждую ячейку в диапазоне, но каждая ячейка должна иметь другой цвет, чем ячейка выше. Код, который я сейчас использую, не выполняет эту дифференциацию. Код:

Function intRndColor()
    'USE - FUNCTION TO PICK RANDOM COLOR, ALSO ALLOWS EXCLUSION OF COLORS YOU DON'T LIKE
    Dim Again As Label
    Dim RangeX As Range
    Set RangeX = Range(Range("A1"), Range("A1").End(xlDown))

    Again:
        intRndColor = Int((50 * Rnd) + 1) 'GENERATE RANDOM IN

        Select Case intRndColor
            Case Is = 0, 1, 5, 9, 3, 13, 29, 30, 11, 21, 25, 29, 30, 32, 49, 51, 52, 55, 56 'COLORS YOU DON'T WANT
                GoTo Again
            Case Is = pubPrevColor
                GoTo Again
        End Select

        pubPrevColor = intRndColor 'ASSIGN CURRENT COLOR TO PREV COLOR

        ' Range(Range("A1"), Range("A1").End(xlDown)).Interior.ColorIndex = pubPrevColor

        For Each c In RangeX
            c.Interior.ColorIndex = pubPrevColor
        Next c
End Function

Этот код делает весь диапазон одним цветом, я не понимаю, чего мне здесь не хватает ...

Answer 1

Вы выбираете случайный цвет правильно (хотя максимальный на 51). Затем вы просто применяете этот один цвет ко всем своим клеткам. Вам нужно выбирать случайный цвет каждый раз, когда вы применяете его к ячейке.

Если вы хотите сделать это без использования GoTo et c.

Dim RangeX As Range, avoidcolours As String, intRndColor As Long, firstcell As Boolean
avoidcolours = ",0,1,5,9,3,13,29,30,11,21,25,29,30,32,49,51,52,55,56,"

Set RangeX = Range(Range("A1"), Range("A1").End(xlDown))
firstcell = True

'Cycle through cells
For Each c In RangeX.Cells
    If firstcell Then
        'Pick random starting colour
        intRndColor = 0
        Do Until InStr(1, avoidcolours, "," & intRndColor & ",") = 0
            intRndColor = Int((50 * Rnd) + 1)
        Loop
        firstcell = False
    Else
        'Pick random colour
        Do Until intRndColor <> c.Offset(-1, 0).Interior.ColorIndex And InStr(1, avoidcolours, "," & intRndColor & ",") = 0
            intRndColor = Int((55 * Rnd) + 1)
        Loop
    End If
    c.Interior.ColorIndex = intRndColor
Next c

---

Немного более аккуратный подход заключается в создании al oop для применения случайного цвета и функции для генерации числа:

Sub applycolours()
    'USE - APPLYS RANDOM COLOURS TO CELLS, DIFFERING FROM CELL ABOVE
    Dim RangeX As Range, intRndColor As Long, firstcell As Boolean

    Set RangeX = Range(Range("A1"), Range("A1").End(xlDown))
    firstcell = True
    'Cycle through cells
    For Each c In RangeX.Cells
        If firstcell Then
            'Pick random starting colour
            intRndColor = randomcolour
            firstcell = False
        Else
            'Pick random colour
            Do Until intRndColor <> c.Offset(-1, 0).Interior.ColorIndex
                intRndColor = randomcolour
            Loop
        End If
        c.Interior.ColorIndex = intRndColor
    Next c
End Sub

Function randomcolour() as long
    'USE - FUNCTION TO PICK RANDOM COLOR, ALSO ALLOWS EXCLUSION OF COLORS YOU DON'T LIKE
    Dim avoidcolours as String
    avoidcolours = ",0,1,5,9,3,13,29,30,11,21,25,29,30,32,49,51,52,55,56,"
    randomcolour = 0
    Do Until InStr(1, avoidcolours, "," & randomcolour & ",") = 0
        randomcolour = Int((55 * Rnd) + 1)
    Loop
End Function

Answer 2

Я думаю, что вы перепутали свои петли. Значение l oop (созданное с меткой goto /) должно быть ВНУТРИ вашего l oop через каждую ячейку в диапазоне:

Function intRndColor()
    'USE - FUNCTION TO PICK RANDOM COLOR, ALSO ALLOWS EXCLUSION OF COLORS YOU DON'T LIKE

    Dim c as Range
    Dim RangeX As Range
    Set RangeX = Range(Range("A1"), Range("A1").End(xlDown))

    'Loop through each cell in range
    For Each c In RangeX

        'Bounce back to this label if the random color is a color we don't want, or the previous color
        Again:
            intRndColor = Int((50 * Rnd) + 1) 'GENERATE RANDOM COLOR INT
            Select Case intRndColor
                Case Is = 0, 1, 5, 9, 3, 13, 29, 30, 11, 21, 25, 29, 30, 32, 49, 51, 52, 55, 56 'COLORS YOU DON'T WANT
                    GoTo Again
                Case Is = pubPrevColor
                    GoTo Again
            End Select

        'Paint the cell we are on
        c.Interior.ColorIndex = intRndColor

        'Set pubPrevColor
        pubPrevColor = intRndColor
    Next c
End Function