麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 請修正上底色的程式碼 [打印本頁]

作者: ziv976688 時間: 2020-1-2 09:02 標題: 請修正上底色的程式碼

測試檔案 : [attach]31617[/attach]
'-抓日期,號碼填黃色------------------------------------------------------------------
Set BK = ThisWorkbook '列65
      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欄日期
If Not xF Is Nothing Then
For V = 4 To 10
   For Each AD In Array("B74:K84", "S74:AB84")
         If xF(1, V) <> "" Then
            Set FF = Range(AD & "").Find(xF(1, V), Lookat:=xlWhole)
            If Not FF Is Nothing Then FF.Font.ColorIndex = IIf(V = 10, 3, 10)
         End If
         If xF(2, V) <> "" Then
            Set FF = Range(AD & "").Find(xF(2, V), Lookat:=xlWhole)
            If Not FF Is Nothing Then FF.Interior.ColorIndex = IIf(V = 10, 8, 6)
         End If
   Next
Next V
End If     '列82
'==============================================================================
目前上述的程式碼執行後的效果檔案，
其Array("B74:K84", "S74:AB84")的底色標示有Bug︰
NG1_指定的單區域的起始儲存格數字，有符合上色條件時，其儲存格無法標示顏色；
EX︰B74(=01)；S74(=01)
NG2_當指定的單區域內，符合上色的數字有重複時，其重複數字儲存格無法標示顏色。
詳如︰49_尾數排序-排數總覽-(2019-11-26)_NG的Array("B74:K84", "S74:AB84")的底色標示。

程式碼執行後的需求效果檔案，詳如︰
49_尾數排序-排數總覽-(2019-11-26)_Ans的Array("B74:K84", "S74:AB84")的底色標示。

請問︰程式主檔的列65~列82程式碼應該如何修正？
敬請各位大大賜教和幫忙！謝謝！

作者: ziv976688 時間: 2020-1-2 09:45

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

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

作者: 准提部林 時間: 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

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

作者: ziv976688 時間: 2020-1-4 11:35

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

作者: ziv976688 時間: 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程式碼應該如何修正？
謝謝您

測試檔案 : [attach]31650[/attach]

作者: 准提部林 時間: 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 '加這一行, 重置陣列
顏色參數自行去改吧~~

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

作者: ziv976688 時間: 2020-1-18 10:54

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

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