[英]Excel VBA Macro Conditional Formatting By Referencing Cell Pair Relative Location
當某些監視單元格為黃色時,我嘗試使用條件格式突出顯示另一列中包含鍵值對的單元格行。 我有一個包含數字的三列(A,B,C),然后是也是數字的兩列(鍵1,鍵2)。 兩列旁邊是傳感器屬性數據,在(AB,BC,AC)下顯示為黃色。 我下面的代碼應該查看屬性單元格,並查看哪些列(AB,BC,AC)為黃色。 然后,它獲取鍵對(鍵1,鍵2),並在三列矩陣中根據值和三列中值的相對順序找到匹配項。 我一直在手動執行此操作,這非常痛苦,我需要嘗試對其進行編碼,但我不知道它是否可行。 我遇到的問題是,發黃的單元格告訴密鑰對的相對順序以在三列中找到匹配項,而我不知道如何實現。
此處的示例文件: 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
結束子
AFAIR u無法使用worksheet_change,因為僅更改背景顏色不會觸發。 最簡單的解決方案是添加一個帶有標題“ highlight 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
結束子
它不是解決此問題的最有效方法,但使用小型工作表應該可以。
添加更多傳感器:數組/集合yellowRows存儲具有至少一個黃色傳感器值的每個key1 / key2組合的行號。 如果要添加的其他傳感器,U可以在當前6個傳感器行后添加列 - =代替的11(C H)和矩陣行設定為例如13,而不是10的新列的位置,並設置iColumn <8如果u添加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'
然后只要復制+粘貼您的原始矩陣的循環(和改變Matrix2.Rows Matrix.Rows)在yellowRows環路(現在u有2路在你的yellowRows環)
關於您的示例文件:
因為您有一個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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.