yen956

補充說明:
1. 不加入序號可不可以?
插入序號, 以便恢復原狀,
除錯的目的不是打亂原表格,
因原VBA利用Excel 的排序功能,
    [A1].Resize(LstR2, 10).Sort _
            Key1:=[C1], Order1:=xlAscending, _
            Key2:=[G1], Order1:=xlAscending, _
            Header:=xlYes
會打亂原表格, 故排序前先加入序號.
如欄A有重要資料可移到他處, 如欄K
若移到欄K,[K1]可鍵入"序號", 原VBA可改成
    [A1].Resize(LstR2, 11).Sort _
            Key1:=[C1], Order1:=xlAscending, _
            Key2:=[G1], Order1:=xlAscending, _
            Header:=xlYes
及將
'插入序號, 以便恢復原狀
Sub 插入序號(LstR As Integer)
    Dim I As Integer
    For I = 2 To LstR
        Cells(I, 1) = I
    Next
End Sub
改成
    For I = 2 To LstR
        Cells(I, 11) = I
    Next
及將
    '恢復原狀, 方便查核
    [A1].Resize(LstR2, 9).Sort _
            Key1:=[A1], Order1:=xlAscending, _
            Header:=xlYes
改成
    [A1].Resize(LstR2, 11).Sort _
            Key1:=[k1], Order1:=xlAscending, _
            Header:=xlYes
最後加入
    [K1:K65536] = ""
予以清除.

yen956

回復 9# RCRG
"不過I24似乎不該出現"到期日異常2"，查看一下原因似乎yen大把製造日的"時間"也比對進去了！製造日只需比對"日期"，後面時間可以忽略"
反正 "製造日" 相同, "到期日" 不同, 就一定會違反 "規則1",
此時要不要 "把製造日的"時間"也比對進去" 就無關緊要了,
這種情形的違反 "規則2" 必 違反 "規則1",
因利用Excel本身的排序功能,
    [A1].Resize(LstR2, 11).Sort _
            Key1:=[C1], Order1:=xlAscending, _
            Key2:=[G1], Order1:=xlAscending, _
            Header:=xlYes
很難避開時間的問題(除非另加補助欄, 先把欄G用公式 =int(G2) 全部去掉時間, 改成日期).

RCRG

回復 3# 准提部林

回復 12# yen956

謝謝兩位熱心又專業的解答，今天至公司實際測試心得如下：

20151219_如何利用VBA按鍵，來找出違反規則號碼.rar (14.99 KB)

下載次數: 4

2015-12-19 11:11

    如上面檔案，再舉個範例8，准大的呈現方式不知能否只在60和61列顯示異常，這樣我比較不會眼花撩亂XD。

兩位大大不知能否幫我加幾項修改
1. 顯示異常的欄位改到A欄和B欄，如下圖1
2. 沒資料 或 貼上資料不符合型式 者，彈出視窗說明(因為我亂填資料會出現錯誤視窗，如下圖2)

圖1

下載 (86.8 KB)
異常顯示改在A-B欄

2015-12-19 11:17

圖2

下載 (67.5 KB)
用彈出視窗來取代錯誤視窗

2015-12-19 11:17

其他大致應該就沒甚麼問題了，再次謝謝兩位大大！

yen956

建議:
1. 另新增一工作表, 內只有號碼、品名(方便輸入有效期限)、有效期限 三欄
2. 號碼是唯一的, 且須由小到大排列(EXCEL 2003必須, 以後版本不清楚), 有效期限以天為單位.
利用進階篩選, 不選重覆, 即可得號碼是唯一的, 操作如下圖:

下載 (686.92 KB)

2015-12-19 13:55

3. 填入有效期限(單位:天), 即三個月應輸入90,
4. 回到主頁(範例說明頁),在 E2 輸入公式, 向下拉
=IF(C2="","",INT(G2)+LOOKUP(C2,Sheet3!A:A,Sheet3!C:C))
(Sheet3 是工作表名稱)
大功告成, 如此保証 "到期日" 絶對不會出錯!!

RCRG

回復 14# yen956


    請教一下yen956大，我發現了一個嚴重的問題，

不該出現異常的竟然跑出一堆異常，因為竟然會去比對不同號碼(正常應該是同號碼下去比較)
，倒是用准大版本的卻沒有這個問題，有勞yen956大幫我看一下好嗎? 謝謝！

20151220_如何利用VBA按鍵，來找出違反規則號碼.rar (17.49 KB)

下載次數: 1

2015-12-20 08:53

問題檔案如上，可以的話修改VBA後，再幫我全部重PO一次讓我抓取好嗎? 再次謝謝了！

准提部林

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

yen956

抱歉!!臨界值沒抓準, 已修改, 請再測試看看!!

1. '插入序號, 以便恢復原狀
   
2. Sub 插入序號(LstR As Integer)
   
3.     Dim I As Integer
   
4.     For I = 2 To LstR
   
5.         Cells(I, 1) = I
   
6.     Next
   
7. End Sub
   
8. Sub test()
   
9.     Dim LstR As Integer, LstR2 As Integer, sR As Integer, I As Integer, cnt As Integer
   
10.     Dim minDate As Date
    
11.     [J2:K65536] = ""
    
12.     '清除底色
    
13.     [J:K].Interior.ColorIndex = xlNone
    
14.     LstR2 = Cells(Rows.Count, 3).End(xlUp).Row
    
15.     插入序號 LstR:=LstR2      '插入序號, 以便恢復原狀
    
16.     [A1].Resize(LstR2, 10).Sort _
    
17.             Key1:=[C1], Order1:=xlAscending, _
    
18.             Key2:=[G1], Order1:=xlAscending, _
    
19.             Header:=xlYes
    
20.     LstR = Cells(Rows.Count, 3).End(xlUp).Row
    
21.     sR = 1
    
22.     Do
    
23.         sR = sR + 1
    
24.         If sR = 2 Then GoTo Next1:
    
25.         cnt = sR
    
26.         Do
    
27.             '規則1.號碼相同且製造日相同, 但到期日不同
    
28.             If Cells(sR, 3) = Cells(sR - 1, 3) And Int(Cells(sR, 7)) = Int(Cells(sR - 1, 7)) And Cells(sR, 5) <> Cells(sR - 1, 5) Then
    
29.                 Cells(sR - 1, 9) = "到期日異常1"
    
30.                 Cells(sR - 1, 9).Interior.ColorIndex = 8
    
31.                 Cells(sR, 9) = "到期日異常1"
    
32.                 Cells(sR, 9).Interior.ColorIndex = 8
    
33.             End If
    
34.             sR = sR + 1
    
35.         Loop Until Cells(sR, 3) <> Cells(sR - 1, 3) Or sR > LstR    '直到 號碼不同 或 資料結尾
    
36.         '規則2. 到期日也必須排序
    
37.         If sR - cnt <= 1 Then GoTo Next1:
    
38.         For I = cnt To sR - 2
    
39.             minDate = Application.Min(Cells(I + 1, 5).Resize(sR - I - 1, 1))
    
40.             If Cells(I, 5) > minDate Then
    
41.                 Cells(I, 10) = "到期日異常2"
    
42.                 Cells(I, 10).Interior.ColorIndex = 38
    
43.             End If
    
44.         Next
    
45. Next1:
    
46.     Loop Until sR >= LstR  '直到資料結尾
    
47.     '恢復原狀, 方便查核
    
48.     [A1].Resize(LstR2, 10).Sort _
    
49.             Key1:=[A1], Order1:=xlAscending, _
    
50.             Header:=xlYes
    
51. End Sub

複製代碼

p.s.
從 製造日 精準到"分鐘"看來, 製造日是由電腦自動輸出的,
但 到期日 為何不用 14# F 的建議, 改用公式自動輸入,
以減少人為 Key In 上的錯誤?
其實, 有違反規則1及規則2 的錯誤, 怎可能沒有 到期日<製造日 的人為 Key In 上的錯誤!?

下載 (69.93 KB)

2015-12-20 11:20

yen956

回復 16# 准提部林
大大抱歉!!來不及用大大新版測試就上傳!!

RCRG

回復 18# yen956


    感謝yen956大修改解答，不過修改完反而變成，如果把日期改為正確，好像也不會把原本的 "異常1&2" 字眼清除了呢！

關於"以減少人為 Key In 上的錯誤?"，其實整篇資料都會是用複製過來的，原則上不會有誤KEY，有誤會的地方應該是我自己檔案舉例不好，但還是先謝謝Y大提醒唷！

yen956

回復 19# RCRG
沒錯, 因錯誤訊息改放到處, 第11列忘了改, 將
    [J2:K65536] = ""
改成
    [H2:J65536] = ""
即可.

p.s.
"其實整篇資料都會是用複製過來的，原則上不會有誤KEY"
那就是原稿就錯?!別的單位送過來的?那又何必除錯?