 2016-0128-Q-1 -.rar (86.1 KB)
下列二個程式只有列11有差異，其餘都相同。
A區和B區的【任一列】對應列交集值=C區~同欄&不限同欄
Private Sub CommandButton1_Click()
Dim b As Range, RW, R(1 To 3) As Range, UR(1 To 3) As Range, x%, z%, i%, U%
With Sheets(2)
Sheets(1).Range("J7", "P" & Sheets(2).[R6] + 5).Copy .[J7]
Application.Goto .Range("T7:T" & .[R7].End(xlDown).Row) '不用Select，直接跳選目標區
For Each b In Selection
If b <> "" Then
If .Range("R" & b.Row) < .[T5] And .Range("R" & b.Row) - 4 > 0 Then
RW = Array(b(1, -1), .[T5], .[R6]) '列11
For x = 1 To 4
For i = 1 To 3: Set UR(i) = Nothing: Next
For z = 1 To 7
Set R(1) = .[J6].Cells(RW(0) - x + 1, z): U = 0
For i = 2 To 3
Set R(i) = Nothing
'Set R(i) = .[J6:P6].Offset(RW(i - 1) - x, 0).Find(R(1), Lookat:=xlWhole) '不同欄
'If Not R(i) Is Nothing Then U = U + i '不同欄
Set R(i) = .[J6:P6].Cells(RW(i - 1) - x + 1, z) '同欄
If R(i) = R(1) Then U = U + i '同欄
Next i
If U = 2 Then Set UR(1) = Nothing: Exit For
If U = 5 Then
For i = 1 To 3
If UR(i) Is Nothing Then Set UR(i) = R(i) Else Set UR(i) = Union(UR(i), R(i))
Next i
End If
Next z
If Not UR(1) Is Nothing Then
For i = 1 To 3
For Each R(1) In UR(i): R(1).Interior.ColorIndex = Array(8, 4, 6)(i - 1): Next
Next i
End If
Next x
End If
End If
Next b
.[A1].Select
End With
End Sub
C區和B區的【任一列】對應列交集值=A區~同欄&不限同欄
Private Sub CommandButton1_Click()
︰
︰
︰
RW = Array(.[R6], .[T5], b(1, -1)) '列11
︰
︰
︰
End Sub
今將上述二個程式合併後成為~
A區和B區的【任一列】對應列交集值=C區&C區和B區的【任一列】對應列交集值=A區~同欄&不限同欄的程式檔案~
其底色無法達成如T7公式的需求~
即如範例檔的輔助圖示W︰AC和AJ︰AP同時有標示同樣底色時，J︰P才標示同樣底色~
(即N91，N102，N105的儲存格沒有標示底色才是正確的)
請問︰應該如何修正合併的程式碼，才能達到如範例檔的J︰P之正確底色標示?
以上 懇請各位先進、前輩不吝賜教! 謝謝! |
發表於 2016-1-28 22:00
| 
發表於 2016-1-29 21:32
| 
