Board logo

標題: [發問] VBA_二區有任一組對應列的相同值全顯示在第三區則標示底色。 [打印本頁]
作者: Airman    時間: 2015-12-30 10:22     標題: VBA_二區有任一組對應列的相同值全顯示在第三區則標示底色。

[attach]23018[/attach]


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

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

以上  懇請各位先進、前輩不吝賜教!  謝謝!
作者: 准提部林    時間: 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
作者: Airman    時間: 2015-12-30 13:01

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

回復 2# 准提部林
[attach]23019[/attach]

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

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

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

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


不好意思~敬請您再次賜正~謝謝您
作者: 准提部林    時間: 2015-12-30 14:12

回復 3# Airman

４９列的〔３９〕，為何只０６符合，４９不算？
６４列的〔５４〕，為何只０６符合，０８．４９不算？
作者: Airman    時間: 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
作者: 准提部林    時間: 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
作者: Airman    時間: 2015-12-30 18:14

本帖最後由 Airman 於 2015-12-30 18:22 編輯

回復 6# 准提部林
准大:
不好意思，一直勞煩您為小弟作解

因為以絕對交叉求同值時，以發問的語法之解(剛好3段公式能互相抵冲掉一組只有二個對應期的交叉求同值)就可以了~
但符合絕對交叉值的實際答案太稀少了~所以只好放寬條件限制~看是否能較符合實務上的推牌需求。

測試OK了~萬分感謝您的耐心教導~感恩
作者: Airman    時間: 2015-12-30 20:07

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

回復 6# 准提部林
[attach]23020[/attach]

准大:
不好意思~剛剛忘了測試同欄~
現在測試後~符合條件的同欄位數字~三區都無法有效標示底色

敬請您再次賜正~感恩

PS: 不限制同欄位數字的底色標示語法完全OK了~謝謝您
作者: 准提部林    時間: 2015-12-30 21:06

回復 8# Airman


Set R(i) = .[J6:P6].Cells(RW(i - 1) - x + 1, z)
作者: Airman    時間: 2015-12-30 21:35

准大:
呵~呵~就差1而已，標示全跑出來了
OK了~再次感謝您的耐心指導~感恩

晚 安~



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)