Question

我有以下代码，它们会在我的工作表中生成随机的颜色和“标题”行。如何将其存储为变量，然后使用它为行着色？（我的目标也是使用此变量以相同的颜色为关联的列单元格上色）。另外，我很确定有办法清理这段代码，以免浪费时间搜索空行？

Sub ColorSuperProjectHeadings()
Dim r As Byte, g As Byte, b As Byte
Dim r2 As Byte, g2 As Byte, b2 As Byte
Dim spcolor As Integer
    Dim vR(), n As Integer
    'Cells.Clear
    n = 3000
    ReDim vR(1 To n)
    For i = 1 To n
        r = WorksheetFunction.RandBetween(0, 127)
        g = WorksheetFunction.RandBetween(0, 127)
        b = WorksheetFunction.RandBetween(0, 127)
        r2 = r + 127
        g2 = g + 127
        b2 = b + 127
        'vR(i) = RGB(r, g, b)
        vR(i) = RGB(r2, g2, b2)
    Next i

    Application.ScreenUpdating = False
        With ActiveSheet


    For Each cell In .Range("Y5:" & .Range("Y1500").End(xlDown).Address)
        If .Cells(cell.Row, 25).value = "Super Project" Then
            cell.EntireRow.Interior.Color = vR(WorksheetFunction.RandBetween(1, n))
        End If
    Next
End With
    Application.ScreenUpdating = True
End Sub

Answer 1

此代码将为每个标题（最后一个除外）的标题左侧的列着色。因此，您可以尝试使用它，以使最后一点起作用，但是基本功能就在那里。

Sub ColorSuperProjectHeadings()

    Dim r As Byte, g As Byte, b As Byte
    Dim r2 As Byte, g2 As Byte, b2 As Byte
    Dim spcolor As Integer
    Dim vR() As Long
    Dim n As Integer
    Dim currentCell As Range
    Dim lastHeader As Range
    Dim lCurrentHeaderColor As Long
    Dim lLastHeaderColor As Long

    'Cells.Clear
    n = 3000
    ReDim vR(1 To n)
    For i = 1 To n
        r = WorksheetFunction.RandBetween(0, 127)
        g = WorksheetFunction.RandBetween(0, 127)
        b = WorksheetFunction.RandBetween(0, 127)
        r2 = r + 127
        g2 = g + 127
        b2 = b + 127
        'vR(i) = RGB(r, g, b)
        vR(i) = RGB(r2, g2, b2)
    Next i

    Application.ScreenUpdating = False
        With ActiveSheet
            For Each cell In .Range("Y5:" & .Range("Y1500").End(xlDown).Address)

                Set currentCell = .Cells(cell.Row, 25)

                If currentCell.Value = "Super Project" Then
                    lCurrentHeaderColor = vR(WorksheetFunction.RandBetween(1, n))
                    cell.EntireRow.Interior.Color = lCurrentHeaderColor

                    If Not lastHeader Is Nothing Then
                        For i = (lastHeader.Row + 1) To (currentCell.Row - 1)
                            'Stop
                            .Cells(i, lastHeader.Column - 1).Interior.Color = lLastHeaderColor
                        Next i
                    End If

                    Set lastHeader = currentCell
                    lLastHeaderColor = lCurrentHeaderColor
                End If
            Next
        End With
    Application.ScreenUpdating = True
End Sub

Excel VBA随机颜色存储为变量

1 个答案: