准提部林

回復 2# Farnsworth


１．你的系統是簡體版，在繁體版中寫VBA時，若需使用中文字無法相容（都是亂碼），如工作表名稱／MSGBOX提示文字，這是問題一
２．需求流程不太詳細＿＿基礎表的內容怎麼來的？
　　是在〔明細表〕輸入後，以〔匯出〕方式填至〔基礎表〕？
　　填入後，基礎表不可被更動（工作表保護？），那〔結業〕兩字如何輸入？
３．既然有〔身份證號〕可比對（其特性應是不會重覆），為何還要同時比對〔姓名〕？

簡體版，建議到EXCEL-HOME的程序版去發帖求助：
http://club.excelhome.net/forum-2-1.html
　
　

准提部林

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim IdRng As Range, xF As Range, xR As Range, C%, j%, Jm%, Km%
   
3. With Target
   
4.      If .Count > 1 Then Exit Sub
   
5.      C = .Column
   
6.      If .Row < 3 Or C < 4 Or C > 7 Then Exit Sub
   
7.      .Interior.ColorIndex = xlNone
   
8.      If .Value = "" Then Exit Sub
   
9.      Set IdRng = Cells(.Row, 2)
   
10.      If IdRng = "" Then Exit Sub
    
11.      Set xF = Sheets("Sheet1").[B:B].Find(IdRng, lookat:=xlWhole)
    
12.      If xF Is Nothing Then MsgBox "找不到身份證號！": Exit Sub
    
13.      If xF(1, 0) <> IdRng(1, 0) Then MsgBox "身份證號與姓名不符！": Exit Sub
    
14.      If xF(1, 21) = "結業" Then MsgBox "本筆已〔結業〕！": .ClearContents: Exit Sub
    
15.      
    
16.      If Not IsDate(.Value) Then MsgBox "輸入日期格式錯誤！":  Exit Sub
    
17.      For j = 1 To 3
    
18.          Set xR = xF(1, 7 + (C - 4) * 3 + j)
    
19.          If xR = .Value Then Jm = 1
    
20.          If xR <> "" Then Km = Km + 1
    
21.          If Jm = 0 And xR = "" Then xR = .Value: Exit Sub
    
22.      Next
    
23.      If Km = 3 Then .Interior.ColorIndex = 6: MsgBox "本區間日期已填滿！": Exit Sub
    
24.      If Jm = 1 Then .Interior.ColorIndex = 3: MsgBox "輸入日期已存在！"
    
25. End With
    
26. End Sub

複製代碼

Xl0000143(身份比對).rar (27.13 KB)

下載次數: 10

2017-4-8 20:08

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
１．工作表名稱自行去改
２．程式碼的繁體中文字，自行改為簡體
　
　

准提部林

1. Sub TEST()
   
2. Dim R&, xR As Range, xF As Range, xE As Range, j%, Jm%, k%, Km%
   
3. R = Cells(Rows.Count, 2).End(xlUp).Row: If R < 3 Then Exit Sub
   
4. Range("A3:I" & R).Interior.ColorIndex = xlNone
   
5. 
   
6. For Each xR In Range("B3:B" & R)
   
7.     If xR = "" Then GoTo 101
   
8.     Set xF = Sheets("Sheet1").[B:B].Find(xR, lookat:=xlWhole)
   
9.     If xF Is Nothing Then xR.Interior.ColorIndex = 3: GoTo 101 '找不到身份證號
   
10.     If xF(1, 0) <> xR(1, 0) Then xR(1, 0).Interior.ColorIndex = 3: GoTo 101 '證號姓名不符
    
11.    
    
12.     If xF(1, 21) = "結業" Then GoTo 101
    
13.    
    
14.     For j = 3 To 6
    
15.         If Not IsDate(xR(1, j)) Then GoTo 102
    
16.         Jm = 0: Km = 0
    
17.         For k = 1 To 3
    
18.             Set xE = xF(1, 7 + (j - 3) * 3 + k)
    
19.             If xR(1, j) = xE Then Jm = 1
    
20.             If xE <> "" Then Km = Km + 1
    
21.             If Jm = 0 And xE = "" Then xE = xR(1, j): Exit For
    
22.         Next k
    
23.         If Km = 3 Then xR(1, j).Interior.ColorIndex = 6: GoTo 102
    
24.         If Jm = 1 Then xR(1, j).Interior.ColorIndex = 3
    
25. 102: Next j
    
26.    
    
27. 101: Next
    
28. End Sub

複製代碼

Xl0000143(身份比對)_v2.rar (27.8 KB)

下載次數: 13

2017-4-8 21:32

這是版本2, 自行去研究, 沒時間再跟帖!