簡體   English   中英

通過引用單元格對相對位置的Excel VBA宏條件格式

[英]Excel VBA Macro Conditional Formatting By Referencing Cell Pair Relative Location

當某些監視單元格為黃色時,我嘗試使用條件格式突出顯示另一列中包含鍵值對的單元格行。 我有一個包含數字的三列(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

結束子

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環)

關於您的示例文件:

  • 在Sub的開頭有一個“ End Sub”需要刪除
  • 矩陣范圍設置錯誤
  • 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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM