如何根据列1中的值改变行颜色?

I want to know how to change row color of a number of rows base on the value in column 1. Lets say in A1 to A5 I have the value "100" and A6 to A10 I have the value "150", i want to be able to change the color of rows 1 to 5 to blue because A1 to A5 has the value "100" and so forth with A6 to A10 to another color because of value "150". Pretty much I need to change the color to the same if the value are the same. My code works but it just changes to all blue and not different color each time the value changes.

我想知道如何根据列1中的值改变行数的行颜色。假设在A1 A5我值“100”和A6 A10值“150”,我希望能够改变行1到5的颜色蓝色因为A1 A5的值“100”等等与A6 A10另一种颜色,因为“150”价值。如果值相同的话，我需要把颜色改成相同的。我的代码可以工作，但是每次值改变时，它就会变成所有的蓝色而不是不同的颜色。

EDIT ANSWER:

编辑回答:

Dim i As Long
Dim holder As String
Set UsedRng = ActiveSheet.UsedRange

FirstRow = UsedRng(1).Row
LastRow = UsedRng(UsedRng.Cells.Count).Row
r = WorksheetFunction.RandBetween(0, 255)
g = WorksheetFunction.RandBetween(0, 255)
b = WorksheetFunction.RandBetween(0, 255)
holder = Cells(FirstRow, 1).Value
For i = FirstRow To LastRow    '<--| loop through rows index
    myColor = RGB(r, g, b)
    If Cells(i, 1).Value = holder Then
        Cells(i, 1).EntireRow.Interior.Color = myColor
    Else
        holder = Cells(i, 1).Value
        r = WorksheetFunction.RandBetween(0, 255)
        g = WorksheetFunction.RandBetween(0, 255)
        b = WorksheetFunction.RandBetween(0, 255)
        Cells(i, 1).EntireRow.Interior.Color = RGB(r, g, b)
 End If
Next i

4 个解决方案

#1

I suggest to do a random color when value changes loop:

当值改变循环时，我建议做一个随机的颜色:

Sub Color()

lastrow = ActiveSheet.UsedRange.Rows.Count

    For i = 2 To lastrow

        If Cells(i, 1).Value = Cells(i - 1, 1).Value Then

            r = WorksheetFunction.RandBetween(0, 255)
            g = WorksheetFunction.RandBetween(0, 255)
            b = WorksheetFunction.RandBetween(0, 255)

            Cells(i, 1).Interior.Color = RGB(r, g, b)

        Else

            Cells(i, 1).Interior.Color = RGB(r, g, b)

        End If
    Next i

End Sub

The result will look like this:

结果将是这样的:

#2

you can begin with this code

您可以从这段代码开始

Sub main()
    Dim myCol As Long, i As Long

    For i = 1 To 10 '<--| loop through rows index
        With Cells(i, 1) '<--| reference cell at row i and column 1
            Select Case .value
                Case 100
                    myCol = vbBlue
                Case 150
                    myCol = vbRed
                Case Else
                    myCol = vbWhite
            End Select
            .EntireRow.Interior.Color = myCol
        End With
    Next i
End Sub

#3

This is how you can check Cells A1 to A10 for value of 100 and if all cells contains 100, paint all rows from 1 to 10 with Blue color.

这是如何检查单元格A1到A10的值为100，如果所有单元格都包含100，则将所有行从1到10用蓝色绘制。

Sub ColorMeBlue()

    Dim iStart, iEnd As Long
    Dim i As Integer
    Dim b As Boolean
    iStart = 1: iEnd = 10

    b = False

    '~~> We will set b to true if all cells in A1:A10 conatins 100
    For i = iStart To iEnd
        If Cells(i, 1) = 100 Then
            b = True
        End If
    Next

    '~~> We will paint Blue if b is true
    If b Then
        Rows("1:10").Interior.Color = vbBlue
    End If

End Sub

You can use same logic to for your next set rows.

对于下一组行，可以使用相同的逻辑。

The reason I didn't put the entire code is so that you can practice on your own.

我没有把所有代码都放进去的原因是你可以自己练习。

#4

Based on your reply to my comment, I assume you neither know the exact values in the first column nor how many different values there are.

根据您对我的评论的回复，我假设您既不知道第一列中的确切值，也不知道有多少不同的值。

To make my answer not too complicated, I assume further that the first column only contains non-negative numbers. If this is not the case, you just have to map the datatype in the column to that number range.

为了使我的答案不太复杂，我进一步假设第一列只包含非负数。如果不是这样，您只需将列中的数据类型映射到该数字范围。

Under the ssumption above you can use the following code.

在上面的ssumption中，您可以使用以下代码。

Public Sub SetRowColorBasedOnValue()
    Dim firstColumn As Range
    Set firstColumn = ActiveSheet.UsedRange.Columns(1)

    Dim minValue As Double
    Dim maxValue As Double

    minValue = Application.Min(firstColumn)
    maxValue = Application.Max(firstColumn)

    Dim cell As Range
    Dim shade As Double
    For Each cell In firstColumn.Cells
        If Not IsEmpty(cell) Then
            shade = (CDbl(cell.Value2) - minValue) / (maxValue - minValue)
            SetRowColorToShade cell, shade
        End If
    Next
End Sub

Private Sub SetRowColorToShade(ByVal cell As Range, ByVal shade As Double)
    With cell.EntireRow.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = shade
        .PatternTintAndShade = 0
    End With
End Sub

Admittedly, the colours can be very similar. If you are using Excel 2013 or later you can use cell.EntireRow.Interior.Color = HSL(hue,saturation,chroma) instead of setting tint and shade to change the hue based on the value. This provides much more different colours.

诚然，颜色很相似。如果您正在使用Excel 2013或更高版本，您可以使用cell.EntireRow.Interior。颜色= HSL(色相、饱和度、色度)而不是根据值设置色调和色度来改变色相。这提供了更多不同的颜色。