通过引用单元格对相对位置的Excel VBA宏条件格式

时间:2009-10-02 21:07:15

标签: excel-vba vba excel

当某些监视单元格为黄色时,我正在尝试使用条件格式设置来突出显示包含另一列中键值对的一行单元格。我有一个包含数字的三列(A,B,C),然后是两列(键1,键2)也是数字。两列旁边是传感器属性数据,在(AB,BC,AC)下变黄。我的下面的代码应该查看属性单元格并查看哪些列(AB,BC,AC)是黄色的。然后它获取密钥对(密钥1,密钥2)并在值和三列中的值的相对顺序方面在三列矩阵中找到匹配。我一直在手动这样做,我需要尝试编码它的痛苦,但我不知道它是否可能。我遇到的问题是泛黄的单元格告诉密钥对的相对顺序,以找到三列中的匹配,我不知道如何将其拉出。

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

此处的示例文件: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

如果有人能给我一些建议,我会非常感激。

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

1 个答案:

答案 0 :(得分:0)

AFAIR你不能使用worksheet_change,因为如果你只改变背景颜色就不会触发它。最简单的解决方案是添加一个带有标题“高亮矩阵”的按钮,该标题遍历感应数据并突出显示矩阵中找到的行。

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

它不是解决此问题的最有效方法,但对于小型工作表应该没问题。

添加更多传感器 数组/集合yellowRows存储具有至少一个黄色传感器值的每个key1 / key2组合的rownumber。如果要添加其他传感器,可以在当前6个传感器行(C - H)之后添加列,并将矩阵行设置为新的列位置e。 G。 13而不是10并设置iColumn&lt; = 11而不是8如果你添加1个新传感器3列。

添加更多矩阵 要添加更多矩阵,您只需在给定布局中的任何位置添加矩阵,并为矩阵定义新范围,例如

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

然后在yellowRows循环中复制+粘贴原始矩阵的for循环(并在Matrix2.Rows中更改Matrix.Rows)(现在你的yellowRows循环中有2个循环)

关于您的示例文件:

  • 开头有一个“End Sub” 需要删除的子
  • Matrix范围设置错误
  • sensordata应从列
  • 开始
  • 因为你有一行id列

       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 '
    

    更改为

       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 '
    
  • 列循环应从5开始 结束于16

以下是修改后的示例文件:http://www.mediafire.com/?vkbyv1n4m0t