- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
規則看起來混亂, 大約寫一下, 眼睛已受不了, 若還有誤差, 等其他大大來吧!- Sub 填色()
- Dim xDic, xR As Range, TR, CC%
- If Not IsDate([C1]) Then MsgBox "日期時間未輸入! ": Exit Sub
- Set xDic = CreateObject("Scripting.Dictionary")
- For Each xR In Range([A1], [A65536].End(xlUp))
- If xR.Row > 1 And xR <> "" Then xDic(xR.Value) = Array(99, 0, 0) '例外料號,以99為識別碼
- Next
- For Each xR In Range([C3], [C65536].End(xlUp))
- If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 101 '無料號或非日期,略過
- TR = xDic(xR.Value) '取出字典檔ITEM
- If Not IsArray(TR) Then TR = Array(0, 0, 0) '首次入字典者, 放入預設陣列
- If TR(0) = 99 Then GoTo 101 '識別碼為99, 表示為例外, 或不符規則, 略過
- If xR(1, 4) > [C1] And TR(1) = 0 Then TR(0) = TR(0) + 10: TR(1) = 1 '大于C1, 加10為識別碼
- If xR(1, 4) < [C1] Then '小于C1時
- If TR(2) = 0 Then TR(0) = TR(0) + 1: TR(2) = Int(xR(1, 4)) '陣列第3個若為0, 表示為第1個日期,填入日期, 識別碼加1
- If Int(xR(1, 4)) <> TR(2) Then TR(0) = 99 '若日期不相同, 表示小于C1日期超過2個,以99為識別碼
- End If
- xDic(xR.Value) = TR
- 101: Next
- For Each xR In Range([C3], [C65536].End(xlUp))
- If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 102
- TR = xDic(xR.Value): CC = 0
- If TR(0) = 10 Then CC = 3 '只有大于C1日期, 識別碼=10
- If TR(0) = 11 And xR(1, 4) < [C1] Then CC = 7 '有大于C1日期, 且小于C1日期只有一個, 識別碼=10+1
- If CC > 0 Then xR.Resize(1, 4).Interior.ColorIndex = CC
- 102: Next
- End Sub
 Xl0000012.rar (15.7 KB)
|
|
發表於 2016-11-19 13:19
| 
