Board logo

標題: [發問] 用VBA根据“姓名”和“身份证号码”，填充信息 [打印本頁]
作者: Farnsworth    時間: 2017-3-28 15:20     標題: 用VBA根据“姓名”和“身份证号码”，填充信息

用VBA比对，根据“姓名”和”身份证号码“比对“基础”表和“明细”表，然后填写“基础”表“I列----T列”。（见图和附件）

[attach]26907[/attach]


[attach]26908[/attach]
作者: Farnsworth    時間: 2017-4-7 10:05

各位高手，等的我心痛啊！急需要啊！个人能力有限，恳请高手
作者: 准提部林    時間: 2017-4-8 10:34

回復 2# Farnsworth


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

簡體版，建議到EXCEL-HOME的程序版去發帖求助：
http://club.excelhome.net/forum-2-1.html
　
　
作者: Farnsworth    時間: 2017-4-8 20:08

回復 3# 准提部林


    乱码的问题我可以改，烦请您给写写VAB代码，感谢！！！以前，你们给我写过，乱码的问题是我自己解
作者: 准提部林    時間: 2017-4-8 20:09

  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
複製代碼
[attach]26976[/attach]

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
１．工作表名稱自行去改
２．程式碼的繁體中文字，自行改為簡體
　
　
作者: Farnsworth    時間: 2017-4-8 20:24

非常感谢，我也在努力学员VBA，希望您有时间能给我
作者: Farnsworth    時間: 2017-4-8 20:29

回復 5# 准提部林


    非常感谢，其实我也一直在努力学习VBA，希望有时间能
作者: 准提部林    時間: 2017-4-8 21:34

  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

  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
複製代碼
[attach]26977[/attach]

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)