[發問] VBA_二區有任一組對應列的相同值全顯示在第三區則標示底色。

2015-1230-Q-1-不同欄~VBA_2R_3ABC_4的【任一列】對應列之交集值.rar (30.75 KB)

原程式碼為任二區的對應列有相同值時，則各標示8號,4號,6號底色~
敬請更修語法如下~

需求︰
當A區∩B區有任一組對應列之相同值(交集值)全顯示在C區時~
則將該組對應列各標示8號,4號,6號底色之語法。
詳如附件圖示。

以上懇請各位先進、前輩不吝賜教! 謝謝!

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

2^#

發表於 2015-12-30 11:16 | 只看該作者

Dim R(1 To 3) As Range, x%, z%, i%, U%
RW = Array(.[T5], .[R6], b(1, -1))
For x = 1 To 4
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 R(i) Is Nothing Then U = 1: Exit For
　　　　'If R(i).Column <> R(1).Column Then U = 1: Exit For '同欄
　　Next i
　　If U = 0 Then
　　　　For i = 1 To 3: R(i).Interior.ColorIndex = Array(4, 6, 8)(i - 1): Next
　　End If
Next z
Next x

TOP

Airman

中學生 Rank: 2

帖子: 315
主題: 51
精華: 0
積分: 367
點名: 0
作業系統: win7
軟體版本: office2003
閱讀權限: 20
性別: 男
註冊時間: 2015-9-29
最後登錄: 2021-10-12

3^#

發表於 2015-12-30 13:01 | 只看該作者

本帖最後由 Airman 於 2015-12-30 13:14 編輯

回復 2# 准提部林

2015-1230-Q-1-不同欄~VBA_2R_3ABC_4的【任一列】對應列之交集值-准大.rar (30.49 KB)

准大:
感謝賜答~有一點小誤差~
目前的解答是︰有點近似~但不完全是~
A區∩B區的某組對應列之任一交叉值有顯示在C區的對應列時，則即將該交叉值各標示底色。

本題的需求是︰
A區∩B區的某組對應列之交叉值全部都有顯示在C區的對應列時，則將該組對應列的交叉值各標示底色。

正確標示詳如︰AQ︰AU圖示。

PS︰7號字顏的數字為A區∩B區的交叉值沒有顯示在C區~則該組對應列不標示底色。

不好意思~敬請您再次賜正~謝謝您

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

4^#

發表於 2015-12-30 14:12 | 只看該作者

回復 3# Airman

４９列的〔３９〕，為何只０６符合，４９不算？
６４列的〔５４〕，為何只０６符合，０８．４９不算？

TOP

Airman

中學生 Rank: 2

帖子: 315
主題: 51
精華: 0
積分: 367
點名: 0
作業系統: win7
軟體版本: office2003
閱讀權限: 20
性別: 男
註冊時間: 2015-9-29
最後登錄: 2021-10-12

5^#

發表於 2015-12-30 15:21 | 只看該作者

本帖最後由 Airman 於 2015-12-30 15:36 編輯

回復 4# 准提部林
准大:
39       02       04       18       20    32       49    30
72    07       13       14       20       21       49       34
96       05       16       23       28       38       47    49
因為A區(39期)和B區(72期)的交集數字為20和49；但只有49有顯示在C區(96期)，20並沒有顯示在C區(96期)~所以這一組對應列不標示底色。

54    04       05    07       13    24       30       49
72       07    13    14       20       21       49    34
96    05       16       23       28       38       47       49
因為A區(54期)和B區(72期)的交集數字為07和13和49；但只有49有顯示在C區(96期)，07和13並沒有顯示在C區(96期)~所以這一組對應列 不標示底色。

55       03       04       08       25       36       42       32
73       08    10       11       21       23       44    42
97       02       08       11       12       26       35       47
因為A區(55期)和B區(73期)的交集數字為08和42；但只有08有顯示在C區(97期)，42並沒有顯示在C區(97期)~所以這一組對應列不標示底色。

其餘...以此類推。

以上  謹供您參考!謝謝您

補充:
本次範例以每區各4期為對應~
即A區有30~33；39~42；54~57 B區為72~75 C區為96~99

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

6^#

發表於 2015-12-30 17:29 | 只看該作者

須多兩道程式:
１．全部檢測一次，收集符合者納入union聯集區
２．逐一聯集區取出儲存格填色

Dim R(1 To 3) As Range, UR(1 To 3) As Range, x%, z%, i%, U%
RW = Array(b(1, -1), .[T5], .[R6])
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, 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
　　End If
Next x

TOP

Airman