[發問] 請修正上底色的程式碼

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

2^#

發表於 2020-1-2 09:45 | 只看該作者

本帖最後由 ziv976688 於 2020-1-2 09:52 編輯

補充 :
為簡化程式碼，以利閱讀，相關符合標示及總表對應日期的數字都是模擬內容。尚請見諒 ! 謝謝 !

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

3^#

發表於 2020-1-4 09:48 | 只看該作者

'-抓日期,號碼填黃色------------------------------------------------------------------
Set BK = ThisWorkbook:  Set xF = Nothing
T = Format(Left(Right(A, 15), 10), "yyyy/m/d") & ChrW(160) '搜尋檔案日期
Set xF = BK.Sheets("DATA").Range("A:A").Find(T, Lookat:=xlPart) '搜尋=A欄日期
Dim FA%(49), FB%(49), xA As Range
If Not xF Is Nothing Then
For V = 4 To 10
   FA(Val(xF(1, V))) = V
   FB(Val(xF(2, V))) = V
Next V
'---------------------------
For Each xA In Range("B74:K84,S74:AB84")
   If FA(Val(xA)) > 0 Then xA.Font.ColorIndex = IIf(FA(Val(xA)) = 10, 3, 10)
   If FB(Val(xA)) > 0 Then xA.Interior.ColorIndex = IIf(FB(Val(xA)) = 10, 8, 6)
Next
End If

'=======================================

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

4^#

發表於 2020-1-4 11:35 | 只看該作者

回復 3# 准提部林
謝謝版主的指正。
測試成功!感恩

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

5^#

發表於 2020-1-18 01:07 | 只看該作者

本帖最後由 ziv976688 於 2020-1-18 01:14 編輯

回復 3# 准提部林
准提版主 : 您好!
您的3樓解題程式碼，都已如需求~
將指定區域的起始儲存格數字和全部符合上色的數字(含有重複)，標示字顏或底色。
謝謝您

=============================================================================
'-抓日期,號碼填黃色------------------------------------------------------------------
Set BK = ThisWorkbook:  Set xF = Nothing '列64
T = Format(Left(Right(A, 15), 10), "yyyy/m/d") & ChrW(160) '搜尋檔案日期
Set xF = BK.Sheets("DATA").Range("A:A").Find(T, Lookat:=xlPart) '搜尋=A欄日期
Dim FA%(49), FB%(49), xA As Range
If Not xF Is Nothing Then
For V = 4 To 10
   FA(Val(xF(1, V))) = V '列70
   FB(Val(xF(2, V))) = V '列71
Next V
'---------------------------
For Each xA In Range("B74:K84,S74:AB84")
   If FA(Val(xA)) > 0 Then xA.Font.ColorIndex = IIf(FA(Val(xA)) = 10, 3, 10) '列75
   If FB(Val(xA)) > 0 Then xA.Interior.ColorIndex = IIf(FB(Val(xA)) = 10, 8, 6)  '列76
Next
End If '列78
'==============================================================================
不好意思，上述您的3樓程式碼會因執行測試檔案的方式，而產生有Bug的效果檔案︰
A方式︰一次只測試單期時 ==> 則各單獨測試期數的應標示數字_全部OK
B方式︰一次測試連續期或多期的期數時==> 則只有測試起始期數的應標示數字_OK，其後的測試期數的應標示數字都有Bug。
請詳見測試檔。

需求︰
請將For Each xA In Range ("B74:K84,S74:AB84")的數字之標示邏輯條件修正為︰
1_有顯示在DATA測試當日期的D欄︰I欄的數字標示10號字顏，有顯示在J欄的數字標示3號字顏。
2_有顯示在DATA測試當日期的下1期的D欄︰I欄的數字標示黃色，有顯示在J欄的數字標示淡藍色。

請問版主︰程式主檔的列64~列78程式碼應該如何修正？
謝謝您

測試檔案 :

請修正上底色的程式碼_2020-0117.rar (78.08 KB)

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

6^#

發表於 2020-1-18 10:14 | 只看該作者

回復 5# ziv976688

Set BK = ThisWorkbook:  Set xF = Nothing
T = Format(Left(Right(A, 15), 10), "yyyy/m/d") & ChrW(160) '搜尋檔案日期
Set xF = BK.Sheets("DATA").Range("A:A").Find(T, Lookat:=xlPart) '搜尋=A欄日期
Dim FA%(49), FB%(49), xA As Range
If Not xF Is Nothing Then
For V = 4 To 10
   FA(Val(xF(1, V))) = V
   FB(Val(xF(2, V))) = V
Next V
'---------------------------
For Each xA In Range("B74:K84,S74:AB84")
   If FA(Val(xA)) > 0 Then xA.Font.ColorIndex = IIf(FA(Val(xA)) = 10, 3, 10)
   If FB(Val(xA)) > 0 Then xA.Interior.ColorIndex = IIf(FB(Val(xA)) = 10, 8, 6)
Next
End If
Erase FA, FB '加這一行, 重置陣列
顏色參數自行去改吧~~

===========================

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

7^#

發表於 2020-1-18 10:54 | 只看該作者

回復 6# 准提部林
准提版主 : 您好!
完全OK了!
謝謝您