- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
本帖最後由 准提部林 於 2015-12-20 11:03 編輯
Sub 檢測1()
Dim xD, xD1, R&, T$, TM1, TM2, i&, TT$
R = [C65536].End(xlUp).Row
[A:B].ClearContents
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
For i = 2 To R
T = Range("C" & i): TM1 = Range("E" & i): TM2 = Range("G" & i)
If T = "" Or IsDate(TM1) = 0 Or IsDate(TM2) = 0 Then GoTo 101
TM1 = Int(TM1): TM2 = Int(TM2)
If TM1 < xD(T) Then xD1(T & TM1) = "2.到期日未排序"
xD(T) = TM1
If xD(T & TM2) = 0 Then xD(T & TM2) = TM1
If xD(T & TM2) <> TM1 Then xD1(T & TM2) = "1.到期日異常": GoTo 101
101: Next
For i = 2 To R
TT = ""
T = Range("C" & i): TM1 = Range("E" & i): TM2 = Range("G" & i)
If T = "" And TM1 = "" And TM2 = "" Then GoTo 102
If T = "" Then TT = "/1.號碼"
If Not IsDate(TM1) Then TT = TT & "" & "/2.到期日"
If Not IsDate(TM2) Then TT = TT & "/3.製造日"
If TT <> "" Then Range("B" & i) = "*請檢查_" & Mid(TT, 2) & "": GoTo 102
TM1 = Int(TM1): TM2 = Int(TM2)
If xD1(T & TM1) <> "" Then Range("A" & i) = xD1(T & TM1)
If xD1(T & TM2) <> "" Then Range("A" & i) = xD1(T & TM2)
102: Next
End Sub |
|