返回列表 上一主題 發帖

[發問] 如何利用VBA按鍵,來找出違反規則的號碼。

在H欄列出錯誤訊息,
用MSGBOX串出一大堆,關閉後忘光光,用處不大!!!

Sub 檢測()
Dim xD, xD1, R&, T$, TM1&, TM2&, i&
R = [C65536].End(xlUp).Row
[H:H].ClearContents
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
For i = 2 To R
  T = Range("C" & i): TM1 = Int(Range("E" & i)): TM2 = Int(Range("G" & i))
  If T = "" Or TM1 = 0 Or TM2 = 0 Then GoTo 101
  If TM1 < xD(T) Then xD1(T & TM1) = "到期日未排序": GoTo 101
  xD(T) = TM1
  If xD(T & TM2) = 0 Then xD(T & TM2) = TM1
  If xD(T & TM2) <> TM1 Then xD1(T & TM2) = "到期日異常": GoTo 101
101: Next
 
For i = 2 To R
  T = Range("C" & i):  TM1 = Int(Range("E" & i)): TM2 = Int(Range("G" & i))
  If xD1(T & TM1) <> "" Then Range("H" & i) = xD1(T & TM1)
  If xD1(T & TM2) <> "" Then Range("H" & i) = xD1(T & TM2)
102: Next
End Sub


〔製造日〕必須先排序,同編號的〔到期日〕比上面的小,就算異常!!

TOP

本帖最後由 准提部林 於 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

TOP

        靜思自在 : 信心、毅力、勇氣三者具備,則天下沒有做不成的事。
返回列表 上一主題