'R7&T5二列的不限同欄或同欄之交集.........................................................................'列38
If .[T5] > .Range("R" & b.Row) And .Range("R" & b.Row) > 0 Then
Dim L(1 To 2)
U = 0: RW = Array(.[T5], .Range("R" & b.Row))
For y = 1 To 2: Set R(y) = .[J:P].Rows(RW(y - 1) + 6).Cells: Next y
For z = 1 To 7
L(1) = z
For y = 1 To 2
L(y) = Application.Match(R(1)(z), R(y), 0)
If IsError(L(y)) Then L(1) = 0: Exit For
'If L(y) <> L(1) Then L(1) = 0: Exit For '若要求〔同欄〕，加入這行
Next y
If L(1) > 0 Then
For y = 1 To 2
R(y)(L(y)).Select
'Selection.Interior.ColorIndex = Array(4, 8)(y - 1) '標示〔個別〕底色
Selection.Font.ColorIndex = 7 '設定文字
Selection.Font.FontStyle = "粗體"
Next
End If
Next z
End If 範例~
1.當M94的33在有顯示在N7且M94在M7的對應值13，有再顯示於K19的儲存格，則M94,M7,K19各標示4號底色。
2.當J94的23在有顯示在P15且J94在J15的對應值04，再顯示於P27的儲存格，則J94,J15,P27各標示40號底色。 其餘......同理類推。
If .[T5] > .Range("R" & b.Row) And .Range("R" & b.Row) > 0 Then
RW = Array(.[T5], b(1, -1), b(1, -1) + .[T3])
For y = 1 To 3: Set UR(y) = .[J:P].Rows(RW(y - 1) + 6).Cells: Next y
For z = 1 To 7
Set R(1) = UR(1)(z): Set R(2) = Nothing: Set R(3) = Nothing
Set R(2) = UR(2).Find(R(1), Lookat:=xlWhole)
If Not R(2) Is Nothing Then
Set R(2) = UR(2)(z)
Set R(3) = UR(3).Find(R(2), Lookat:=xlWhole)
End If
If Not R(3) Is Nothing Then
For y = 1 To 3
R(y).Interior.ColorIndex = Array(40, 39, 45, 4, 38, 37, 8)(z - 1)
Next
Set R(2) = UR(2).Find(R(1), Lookat:=xlWhole)
For y = 1 To 2
R(y).Font.ColorIndex = 7 '設定文字
R(y).Font.FontStyle = "粗體"
Next y
End If
Next z
End If
For z = 1 To 7
Set R(1) = UR(1)(z): Set R(2) = Nothing: Set R(3) = Nothing
If UR(2)(z) = R(1) Then
Set R(2) = UR(2)(z) '同欄
Set R(3) = UR(3).Find(R(2), Lookat:=xlWhole) '不同欄
'If UR(3)(z) = R(1) Then Set R(3) = UR(3)(z) '同欄
End If
If Not R(3) Is Nothing Then
For y = 1 To 3
R(y).Interior.ColorIndex = Array(40, 39, 45, 4, 38, 37, 8)(z - 1)
Next
For y = 1 To 2
R(y).Font.ColorIndex = 7 '設定文字
R(y).Font.FontStyle = "粗體"
Next y
End If
Next z作者: Airman 時間: 2016-2-5 16:36
)
