VBA_A期數在B期數的對應值有再顯示於C期數的儲存格時，則各標示底色之語法。

Airman

VBA_A在B的對應值再顯示於C的不限同欄&同欄之底色標示.rar (26.59 KB)

下載次數: 0

2016-2-1 22:15

標題說明︰
A期數=T$5期數的J︰P之7個值
B期數=$R7期數的J︰P之7個值
C期數=$R7+T$3期數的J︰P之7個儲存格

需求︰再增加下列語法~
當T$5期數的J︰P之7個值，其在$R7期數的J︰P之7個對應值，有再顯示於$R7+T$3期數的J︰P之7個儲存格中時~
則將符合條件的各組合，根據T$5期數J︰P欄位的順位~依序標示40號,39號,45號,4號,38號,37號,8號底色之語法。

範例~
1.M94在M7的對應值13，再顯示於K19的儲存格，則M94,M7,K19各標示4號底色。
2.J94在J15的對應值04，再顯示於P27的儲存格，則J94,J15,P27各標示40號底色。
其餘......同理類推。

詳如附件。(請點選上方之附件)

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


抱歉!下方這個附件作廢(不知為何刪不掉 )

Airman

回復 1# Airman

抱歉 ^^"   #1 作廢

更改需求~

VBA_列39~列59增修.rar (26.76 KB)

下載次數: 1

2016-2-2 16:47

需求︰請將列39~列59的程式碼增修為~
當T$5期數的J︰P之值，有顯示在$R7期數的J︰P之儲存格中~
且該T$5期數的J︰P值，其在$R7期數之對應值，有再顯示於$R7+T$3期數的J︰P之儲存格中時~
則將符合上述條件的各組合，根據T$5期數J︰P欄位的順位~依序標示40號,39號,45號,4號,38號,37號,8號底色之語法。

'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號底色。
其餘......同理類推。

詳如附件。

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

准提部林

回復 2# Airman


   VBA_列39~列59增修_v1.rar (27.66 KB)

下載次數: 3

2016-2-3 19:14

Airman

回復 3# 准提部林

准大:
謝謝您的費神賜教~感恩

貴解答檔的測試結果:尚有一個小誤差~
7號字顏~是標示在T$5期數和$R7期數的相同值(交集值)~
詳如:需求答案的參考圖示      PS: M70和M82的33會同時有7號字顏和4號底色，
是因為T$5的期數(=88期)各與$R70和$R82的期數(=64期和=76期)的相同值(交集值)剛好是同欄位的關係。

以上  敬請您賜正為禱~謝謝您

Airman

回復 3# 准提部林
准大:
不好意思~ 4#說明中的相同值(交集值)好像有漏洞(語病)

重新說明︰
條件1_當T$5期數的J︰P儲存格數字在$R7期數的對應儲存格數字有再顯示於$R7+T$3期數的J︰P儲存格中時~
條件2_符合條件1之T$5的J︰P儲存格數字亦有顯示在$R7期數的J︰P儲存格中。

當上述的二個條件都符合時，則~
符合條件_1的T$5，$R7，$R7+T$3的3個儲存格各標示底色(底色順序如貴解答檔)；
符合條件_2的T$5，$R7，$R7+T$3的3個儲存格各標示7號粗字顏。

詳如:需求答案的參考圖示

以上  敬請您賜正為禱~謝謝您

Airman

回復 5# Airman
抱歉~有筆誤~
符合條件_2的T$5，$R7，$R7+T$3的3個儲存格各標示7號粗字顏。
改為:
符合條件_2的T$5，$R7的2個儲存格各標示7號粗字顏。
謝謝!

准提部林

回復 6# Airman


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

這種密密麻麻的文字描述, 程式碼新舊混合, 實在不太習慣, 太花時間及眼力!!!

Airman

回復 7# 准提部林
准大:
測試完全OK了~感恩

如果說明的文字標示顏色會令您眼花瞭亂~小弟以後就不標示字顏~以利您閱讀。
至於文字說明的方式~小弟會盡量改進~力求簡扼。
會以原程式或原公式的增修來達到新需求~是想因原程式或原公式都為您的原作~所以誤以為會這樣比較容易理解。
今後小弟會改變提問的方式~之前造成您的所有不便~敬請海涵。謝謝您

Airman

回復 7# 准提部林
准大:
雖然書是買了很多~但 一直有看沒有懂
所以常以需求的稍微變化來比對而吸取程式的寫法。
您的語法小弟也漸漸適應~相信同類需求會慢慢減少。

不好意思~想再將貴解程式碼的需求改為: 二個期數【同欄位之相同數字】的再出現於它期之標示語法。
說明:
當T$5和$R7期數的J︰P【同欄位之相同數字】有再顯示於$R7+T$3期數的同欄位或不同欄位之儲存格中時~
則將符合條件的3個期數，根據T$5期數J︰P欄位之順位~依序標示40號,39號,45號,4號,38號,37號,8號底色，
並將T$5和$R7的【同欄位之相同數字】再標示7號粗字顏的語法。

詳如附件 二個期數同欄位相同值的再出現之標示語法。.rar (31.54 KB)

下載次數: 2

2016-2-5 10:28

以上  敬請您賜教為禱!感恩

准提部林

回復 9# Airman

修改部份大致都對，其實自己多測幾次去漸次修改，也可以的！！！

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