简体   繁体   中英

Excel VBA Macro Conditional Formatting By Referencing Cell Pair Relative Location

I am trying to use conditional formatting to highlight a row of cells containing key value pairs in another column when certain watch cells are yellow. I have a three columns (A,B,C) containing numeric digits and then two columns (key 1, key2) that is also numeric. Next to the two columns are sensor attribute data that is yellowed under (AB,BC,AC). My code below is supposed to look at athe attribute cells and see under which columns (AB,BC,AC) are yellow. Then it takes the key pairs (key 1, key2) and finds a match in the three column matrix in terms of values and the relative order of the value in the three columns. I've been doing this manually and its so much of a pain I need to try to code it but I don't know if its possible. The problem I have is that the yellowed cells tells the relative order of the key pairs to find the match in the three columns and I do not know how to pull that off.

https://i972.photobucket.com/albums/ae203/sungate9/ExcelMacro.gif

Sample file here: http://www.filefactory.com/file/a0egf75/n/Relative_Position_Macro_xls

Key 1   Key 2   AB  BC  AC  AB  BC  AC
0   0   0.0000  0.0000  0.0000  0.0000  0.0000  0.0000
0   1   -1.5574 -1.5574 -1.5574 1.5574  1.5574  1.5574
0   2   2.1850  2.1850  2.1850  -2.1850 -2.1850 -2.1850
0   3   0.1425  0.1425  0.1425  -0.1425 -0.1425 -0.1425
0   4   -1.1578 -1.1578 -1.1578 1.1578  1.1578  1.1578
0   5   3.3805  3.3805  3.3805  -3.3805 -3.3805 -3.3805
0   6   0.2910  0.2910  0.2910  -0.2910 -0.2910 -0.2910
0   7   -0.8714 -0.8714 -0.8714 0.8714  0.8714  0.8714
0   8   6.7997  6.7997  6.7997  -6.7997 -6.7997 -6.7997
0   9   0.4523  0.4523  0.4523  -0.4523 -0.4523 -0.4523
1   0   1.5574  1.5574  1.5574  1.5574  1.5574  1.5574
1   1   0.0000  0.0000  0.0000  -2.1850 -2.1850 -2.1850
1   2   -1.5574 -1.5574 -1.5574 -0.1425 -0.1425 -0.1425
1   3   2.1850  2.1850  2.1850  1.1578  1.1578  1.1578
1   4   0.1425  0.1425  0.1425  -3.3805 -3.3805 -3.3805
1   5   -1.1578 -1.1578 -1.1578 -0.2910 -0.2910 -0.2910
1   6   3.3805  3.3805  3.3805  0.8714  0.8714  0.8714
1   7   0.2910  0.2910  0.2910  -6.7997 -6.7997 -6.7997
1   8   -0.8714 -0.8714 -0.8714 -0.4523 -0.4523 -0.4523
1   9   6.7997  6.7997  6.7997  0.6484  0.6484  0.6484
2   0   -2.1850 -2.1850 -2.1850 -2.1850 -2.1850 -2.1850
2   1   1.5574  1.5574  1.5574  -0.1425 -0.1425 -0.1425
2   2   0.0000  0.0000  0.0000  1.1578  1.1578  1.1578
2   3   -1.5574 -1.5574 -1.5574 -3.3805 -3.3805 -3.3805
2   4   2.1850  2.1850  2.1850  -0.2910 -0.2910 -0.2910
2   5   0.1425  0.1425  0.1425  0.8714  0.8714  0.8714
2   6   -1.1578 -1.1578 -1.1578 -6.7997 -6.7997 -6.7997
2   7   3.3805  3.3805  3.3805  -0.4523 -0.4523 -0.4523
2   8   0.2910  0.2910  0.2910  0.6484  0.6484  0.6484

A   B   C
0   8   9
0   7   8
0   6   7
0   5   6
0   4   5
0   7   9
0   3   4
0   5   7
0   2   3
0   4   6
0   5   8
2   1   5
0   4   7
0   5   9
0   4   8
0   4   9
0   3   7
0   2   5
0   3   9
0   1   3
0   2   6
0   2   7
0   1   4
0   2   9
0   1   5
0   1   6
0   1   7
0   1   8
0   1   9

If anyone can offer me some suggestions, I would really appreciate it.

Dim WatchRange As Range, Target As Range, cell As Range
Set WatchRange = Range("C4:H32") 
Set Target = Range("J4:J32")

For Each cell In WatchRange.Cells
  If ColorIndex: = 6 , A4 = J4, B4 = K4  Then: targetCell.Interior.ColorIndex = 3
    Next watchCell
    Else: cell.Interior.ColorIndex = xlNone
    End If
Next cell

End Sub

AFAIR u can't work with worksheet_change because it doesn't fire if you only change the background color. The simplest solution is to add a button with the caption "highlight matrix" that walks through your sensordata and highlights the found rows in the matrix.

Private Sub highlightMatrix()
Dim SensorData As Range
Dim Matrix As Range
Dim yellowRows As Collection
Dim isYellow As Boolean
Dim iColumn As Integer

Set SensorData = Worksheets.Item(1).Cells(3, 1).CurrentRegion
Set Matrix = Worksheets.Item(1).Cells(3, 10).CurrentRegion
Set yellowRows = New Collection

For Each Row In SensorData.Rows     ' walk the used rows of sensordata '
    isYellow = False
    iColumn = 3

    While iColumn >= 3 And iColumn <= 8 And isYellow = False    ' identify rows with yellow marked sensordata '
        If Row.Cells(1, iColumn).Interior.ColorIndex = 6 Then
            isYellow = True
            yellowRows.Add (Row.Row)
        End If
        iColumn = iColumn + 1
    Wend
Next Row

Matrix.Interior.ColorIndex = xlNone  ' set matrix background to default '
For Each Item In yellowRows
    For Each Row In Matrix.Rows
        If Row.Cells(1, 1) = Worksheets.Item(1).Cells(Item, 1) And Row.Cells(1, 2) = Worksheets.Item(1).Cells(Item, 2) Then ' color found rows red '
            Row.Cells(1, 1).Interior.ColorIndex = 3
            Row.Cells(1, 2).Interior.ColorIndex = 3
            Row.Cells(1, 3).Interior.ColorIndex = 3
        End If
    Next Row
Next Item

Set yellowRows = Nothing

End Sub

Its not the most efficient way to solve this problem but it should be fine with small worksheets.

Adding more Sensors: The array/collection yellowRows stores the rownumbers of every key1/key2 combination that has at least one yellow sensor value. If you want to add other sensors, u could add the columns after the current 6 sensor rows (C - H) and set the matrix row to the new column position eg 13 instead of 10 and set iColumn <= 11 instead of 8 if u add 1 new sensor with 3 columns.

Adding more Matrices: To add more matrices u simply need to add a matrix in the given layout anywhere and define a new range for the matrix eg

Set Matrix2 = Worksheets.Item(1).Cells(100, 1).CurrentRegion 'Matrix 2 starts in the 100. row on the 1. spreadsheet in the 1. column'

then just copy+paste the for loop of your original matrix(and change Matrix.Rows in Matrix2.Rows) in the yellowRows loops (now u have 2 Loops in your yellowRows loop)

Regarding your Sample file:

  • There was a "End Sub" at the start of the Sub that needed to be deleted
  • The Matrix range was set wrong
  • the sensordata should start at column
  • Because you have an id column the line

      If Row.Cells(1, 1) = Worksheets.Item(1).Cells(Item, 1) And Row.Cells(1, 2) = Worksheets.Item(1).Cells(Item, 2) Then ' color found rows red ' 

    changes to

      If Row.Cells(1, 1) = Worksheets.Item(1).Cells(Item, 2) And Row.Cells(1, 2) = Worksheets.Item(1).Cells(Item, 3) Then ' color found rows red ' 
  • the column loop should start at 5 and end at 16

Here is the modified Sample File: http://www.mediafire.com/?vkbyv1n4m0t

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM