返回列表 上一主題 發帖

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

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-1-2 09:02 | 只看該作者

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

測試檔案 : 請修正上底色的程式碼.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

帖子
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 編輯

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

TOP

准提部林

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

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

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
4#
發表於 2020-1-4 11:35 | 只看該作者
回復 3# 准提部林
謝謝版主的指正。
測試成功!感恩

TOP

ziv976688

帖子
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)

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-29 
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 '加這一行, 重置陣列  
顏色參數自行去改吧~~


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

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
7#
發表於 2020-1-18 10:54 | 只看該作者
回復 6# 准提部林
准提版主 : 您好!
完全OK了!
謝謝您

TOP

        靜思自在 : 不怕事多，只怕多事。
返回列表 上一主題