- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-2-11
|
回復 10# 准提部林
謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導
執行前:
執行結果:
Sub 填色()
Dim xDic, xR As Range, TR, CC%
'↑宣告變數
If Not IsDate([C1]) Then MsgBox "日期時間未輸入! ": Exit Sub
'↑檢測[C1]需要輸入正確日期時間
Set xDic = CreateObject("Scripting.Dictionary")
'↑令xDic是字典
For Each xR In Range([A1], [A65536].End(xlUp))
'↑設逐項迴圈!令xR是A欄的儲存格
If xR.Row > 1 And xR <> "" Then xDic(xR.Value) = Array(99, 0, 0)
'↑例外料號,以99為識別碼
'以xR儲存格值為key,item是一維陣列,0索引號值是99
Next
For Each xR In Range([C3], [C65536].End(xlUp))
'↑設逐項迴圈!令xR是C欄的儲存格
If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 101
'↑如果無料號或非日期,跳到101標示位置繼續執行
TR = xDic(xR.Value)
'↑令TR變數是xR變數查xDic字典回傳的item值(取出字典檔ITEM)
If Not IsArray(TR) Then TR = Array(0, 0, 0)
'↑如果TR變數還不是陣列!就令TR變數是一維陣列(首次入字典者, 放入預設陣列)
If TR(0) = 99 Then GoTo 101
'↑如果識別碼為99, 表示為例外, 或不符規則,跳到101標示位置繼續執行
If xR(1, 4) > [C1] And TR(1) = 0 Then TR(0) = TR(0) + 10: TR(1) = 1
'↑如果xR儲存格(含)右側第4格大於[C1]儲存格時間,而且1索引號TR陣列是0 !
'就令0索引號TR陣列值累加10(是0加10為識別碼),令1索引號TR陣列值是1
If xR(1, 4) < [C1] Then
'↑如果日期欄值小於[C1]值時?
If TR(2) = 0 Then TR(0) = TR(0) + 1: TR(2) = Int(xR(1, 4))
'↑TR陣列2索引號值若為0, 表示為第1個日期,填入日期, 識別碼加1
If Int(xR(1, 4)) <> TR(2) Then TR(0) = 99
'↑若日期不相同, 表示小于C1日期超過2個,以99為識別碼
End If
xDic(xR.Value) = TR
'↑以xR儲存格值當key,item是TR變數(一維陣列),納入xDic字典
101: Next
For Each xR In Range([C3], [C65536].End(xlUp))
'↑設逐項迴圈!令xR是C欄的儲存格
If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 102
'↑如果無料號或非日期,跳到102標示位置繼續執行
TR = xDic(xR.Value): CC = 0
'↑令TR變數盛出 xR儲存格值在xDic字典裡的item(一維陣列):令CC變數歸零
If TR(0) = 10 Then CC = 3
'↑如果只有大于C1日期 ,0索引號TR陣列值是10(識別碼 = 10),就令CC變數是3
If TR(0) = 11 And xR(1, 4) < [C1] Then CC = 7
'↑如果有大于C1日期, 且小于C1日期只有一個, 識別碼=10+1),就令CC變數是7
If CC > 0 Then xR.Resize(1, 4).Interior.ColorIndex = CC
'↑上底色
102: Next
End Sub |
|
發表於 2023-5-10 09:10
| 