返回列表 上一主題 發帖

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

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

測試檔案 : 請修正上底色的程式碼.rar (53.32 KB)
'-抓日期,號碼填黃色------------------------------------------------------------------
    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:52 編輯

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

TOP

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

'=======================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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

TOP

本帖最後由 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)

TOP

回復 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 '加這一行, 重置陣列  
顏色參數自行去改吧~~


===========================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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

TOP

        靜思自在 : 能幹不幹,不如苦幹實幹。
返回列表 上一主題