VBA根据下拉值替换颜色

时间:2015-08-20 08:51:24

标签: excel vba excel-vba

我一直在研究一个宏,它根据下拉值用颜色填充某些单元格。选择值并更改它时,它不会删除上次根据其值填充的颜色。当工作表更改时,宏将在私有子上运行。然后检查单元格值并用颜色填充字段。当某些内容发生变化时,私有子值是否会重置以重置活动行?以下是字段中要着色的宏代码:

 Sub Validate()


Dim rng As Range
Dim row As Range
Dim cell As Range
Dim counter As Long
Dim clrGrren As Long
Dim clrWhite As Long
clrGreen = RGB(Red:=180, Green:=236, Blue:=180)
clrWhite = RGB(Red:=255, Green:=255, Blue:=255)

Set rng = Range("D4:D1000")



For Each cell In rng


Select Case cell.Value

Case Is = "Action Figures"
    cell.Offset(counter, 12).Interior.Color = clrGreen
    cell.Offset(counter, 13).Interior.Color = clrGreen
    cell.Offset(counter, 21).Interior.Color = clrGreen
    cell.Offset(counter, 22).Interior.Color = clrGreen
    cell.Offset(counter, 23).Interior.Color = clrGreen
    cell.Offset(counter, 29).Interior.ColorIndex = 16
    cell.Offset(counter, 30).Interior.ColorIndex = 16
    cell.Offset(counter, 31).Interior.Color = clrGreen
    cell.Offset(counter, 32).Interior.Color = clrGreen
    cell.Offset(counter, 34).Interior.ColorIndex = 16
    cell.Offset(counter, 35).Interior.Color = clrGreen
    cell.Offset(counter, 38).Interior.ColorIndex = 16
    cell.Offset(counter, 39).Interior.ColorIndex = 16
    cell.Offset(counter, 41).Interior.ColorIndex = 16
    cell.Offset(counter, 42).Interior.ColorIndex = 16
    cell.Offset(counter, 43).Interior.ColorIndex = 16
    cell.Offset(counter, 44).Interior.ColorIndex = 16

1 个答案:

答案 0 :(得分:0)

您应该包含检查单元格值的代码,并更新Private Sub Worksheet_Change()中相应的单元格颜色而不是用户定义的sub。保存工作表,然后尝试更新值。目标细胞的颜色会自动改变。

Dim rng As Range
Dim row As Range
Dim cell As Range
Dim counter As Long
Dim clrGreen As Long
Dim clrWhite As Long
Dim clrBlue As Long

    Private Sub Worksheet_Change(ByVal cell As Range)
    clrGreen = RGB(Red:=180, Green:=236, Blue:=180)
    clrWhite = RGB(Red:=255, Green:=255, Blue:=255)
    clrBlue = RGB(Red:=0, Green:=0, Blue:=255)

    Select Case cell.Value

    Case Is = "Action Figures"
        cell.Offset(counter, 12).Interior.Color = clrGreen
        cell.Offset(counter, 13).Interior.Color = clrGreen
        cell.Offset(counter, 21).Interior.Color = clrGreen
        cell.Offset(counter, 22).Interior.Color = clrGreen
        cell.Offset(counter, 23).Interior.Color = clrGreen
        cell.Offset(counter, 29).Interior.ColorIndex = 16
        cell.Offset(counter, 30).Interior.ColorIndex = 16
        cell.Offset(counter, 31).Interior.Color = clrGreen
        cell.Offset(counter, 32).Interior.Color = clrGreen
        cell.Offset(counter, 34).Interior.ColorIndex = 16
        cell.Offset(counter, 35).Interior.Color = clrGreen
        cell.Offset(counter, 38).Interior.ColorIndex = 16
        cell.Offset(counter, 39).Interior.ColorIndex = 16
        cell.Offset(counter, 41).Interior.ColorIndex = 16
        cell.Offset(counter, 42).Interior.ColorIndex = 16
        cell.Offset(counter, 43).Interior.ColorIndex = 16
        cell.Offset(counter, 44).Interior.ColorIndex = 16

    Case Is = "Dolls"
        cell.Offset(counter, 12).Interior.Color = clrBlue
        cell.Offset(counter, 13).Interior.Color = clrBlue
        cell.Offset(counter, 21).Interior.Color = clrBlue
        cell.Offset(counter, 22).Interior.Color = clrBlue
        cell.Offset(counter, 23).Interior.Color = clrBlue
        cell.Offset(counter, 29).Interior.ColorIndex = 16
        cell.Offset(counter, 30).Interior.ColorIndex = 16
        cell.Offset(counter, 31).Interior.Color = clrBlue
        cell.Offset(counter, 32).Interior.Color = clrBlue
        cell.Offset(counter, 34).Interior.ColorIndex = 16
        cell.Offset(counter, 35).Interior.Color = clrBlue
        cell.Offset(counter, 38).Interior.ColorIndex = 16
        cell.Offset(counter, 39).Interior.ColorIndex = 16
        cell.Offset(counter, 41).Interior.ColorIndex = 16
        cell.Offset(counter, 42).Interior.ColorIndex = 16
        cell.Offset(counter, 43).Interior.ColorIndex = 16
        cell.Offset(counter, 44).Interior.ColorIndex = 16
    End Select

End Sub