If value will change, change few cells color

问题:

i can't find answer for my issue, maybe you can helf me to solve this problem. I want to change this VBA Script to have something like:

• if in column A value will change - run VBA Script
• for example, if in cell A2 or A3, or A4 and so on = 1, (cells B2, C2, E2, H2) will green and (D2, F2, G2 and J2) will rot. if A2 or A3 ...... = 2 (B2, C2,) will green, D2, F2 will rot

if A3 value will change, than change B3, C3 if A4 will change, change B4, C4 and so on

Values in column A user will change "by hand"

Sub ChangeColor()

Set sht = ThisWorkbook.Worksheets("csv_vorlage")

LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Set MyPlage = Range("A1:A" & LastRow) 'MsgBox (MyPlage) For Each cell In MyPlage Select Case cell.Value Case Is = "1" Range("B2:F2").EntireRow.Interior.ColorIndex = 3 'red Case Is = "2" cell.EntireRow.Interior.ColorIndex = 4 'green Case Is = "3" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "4" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "5" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "6" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "7" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "8" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "9" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "10" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "11" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "12" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "13" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "14" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "15" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "16" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "17" cell.EntireRow.Interior.ColorIndex = 4 Case Is = "19" cell.EntireRow.Interior.ColorIndex = 4 Case Else cell.EntireRow.Interior.ColorIndex = 0 End Select Next End Sub

and how to do that ?

回答1:

First move your code to Worksheet_Change event, and only check the values if a value in column A was modified.

Use Select Case to add multiple scenarios you want to check against when modifying the color of to Green.

Code

Option Explicit  Private Sub Worksheet_Change(ByVal Target As Range)  Dim LastRow As Long  LastRow = Cells(Rows.Count, "A").End(xlUp).Row  If Not Intersect(Target, Range("A1:A" & LastRow)) Is Nothing Then     Select Case Target.Value         Case "1", "2", "3", "4" '<-- put the rest of your cases here             Range("B" & Target.Row & ":C" & Target.Row & ",E" & Target.Row & ":H" & Target.Row).Interior.ColorIndex = 4  'green         Case Else             Range("B" & Target.Row & ":C" & Target.Row & ",E" & Target.Row & ":H" & Target.Row).Interior.ColorIndex = 0     End Select End If  End Sub 

回答2:

your narrative isn't clear as long as actual coloring rules are concerned

but since you clarifed cell will be changed "manually" by the user, then you can go like follows:

• in the "csv_vorlage" worksheet code pane, place the following code:

  Private Sub Worksheet_Change(ByVal target As Range)     If target.Column = 1 Then ChangeColor target '<--| if any changed cell is in column A then call the color handler sub End Sub 

• in the same code pane or in any other Module, place the following code

  Sub ChangeColor(target As Range)     Dim colorIndex1 As Long, colorIndex2 As Long      Select Case target.Value         Case 1             colorIndex1 = 4 'green             colorIndex2 = 3 'red         Case 2             colorIndex1 = 3 'red             colorIndex2 = 4 'green          Case 3 To 5             colorIndex1 = 5 'blue             colorIndex2 = 6 'yellow          Case Else             colorIndex1 = xlColorIndexNone             colorIndex2 = xlColorIndexNone     End Select      target.Range("B1,C1,E1,H1").Interior.ColorIndex = colorIndex1     target.Range("D1,F1,G1,J1").Interior.ColorIndex = colorIndex2 End Sub 

as you see, you can play around with every Case just changing colorIndex1 and colorIndex2 as per your need

furthermore a single Case can handle a range of target values like Case 3 To 5 and the likes, and let you reduce significantly the typing burden

文章来源: If value will change, change few cells color