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

ziv976688

測試檔案 : 請修正上底色的程式碼.rar (53.32 KB)

下載次數: 7

2020-1-2 09:01

'-抓日期,號碼填黃色------------------------------------------------------------------
    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

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

准提部林

'-抓日期,號碼填黃色------------------------------------------------------------------
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

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

ziv976688

回復 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)

下載次數: 3

2020-1-18 01:07

准提部林

回復 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

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