返回列表 上一主題 發帖

[發問] 身分證代碼

[發問] 身分證代碼

若在A1儲存格輸入  a123456789
有無方法或公式?
將A1儲存格內容自動轉換成   A123456789(要在同一儲存格)
請各位先進高手解惑
感恩  ^^

回復 14# sillykin


    巳解決

TOP

回復 12# 准提部林


    Private Sub Worksheet_Change(ByVal Target As Range) '借戶身分證檢查
Dim T, i%, S
With Target
      If .Count > 1 Then Exit Sub
      If Intersect([B5], .Cells) Is Nothing Then Exit Sub
      Application.EnableEvents = False
      .Value = UCase(.Value)
      Application.EnableEvents = True
      
      If Not .Value Like "[A-Z]#########" Then MsgBox "身份證輸入錯誤!!": Exit Sub
      T = InStr("ABCDEFGHJKLMNPQRSTUVXYWZIO", Left(.Value, 1)) + 9 & Mid(.Value, 2, 8)
      For i = 1 To 10
          S = S + Mid(T, i, 1) * Left(11 - i, 1)
      Next i
      T = Right(10 - Right(S, 1), 1)
      If T <> Mid(.Value, 10, 1) Then MsgBox "身份證字號錯誤!檢查碼:" & T
End With

如果另外要在加入
[B5]及
[B51] ~[P51]15個身份證檢查
VBA要如何加入呢???

TOP

回復 12# 准提部林
:loveliness:
真的太神了!!
感謝ML089、rouber590324、准提部林等先進的指導
所提出的疑問
已經獲得完美的解決
感恩  ^^

TOP

Private Sub Worksheet_Change(ByVal Target As Range)
Dim T, i%, S
With Target
   If .Count > 1 Then Exit Sub
   If Intersect([H5:H6], .Cells) Is Nothing Then Exit Sub
   Application.EnableEvents = False
   .Value = UCase(.Value)
   Application.EnableEvents = True
      
   If Not .Value Like "[A-Z]#########" Then MsgBox "身份證輸入錯誤!!": Exit Sub
   T = InStr("ABCDEFGHJKLMNPQRSTUVXYWZIO", Left(.Value, 1)) + 9 & Mid(.Value, 2, 8)
   For i = 1 To 10
     S = S + Mid(T, i, 1) * Left(11 - i, 1)
   Next i
   T = Right(10 - Right(S, 1), 1)
   If T <> Mid(.Value, 10, 1) Then MsgBox "身份證字號錯誤!檢查碼:" & T
End With
End Sub

TOP

回復 1# cypd
你要先說明身分證的檢核規則。
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

身分證檢核

若是要在H5之儲存格輸入...a123456789
試問
能在同一格儲存格自動轉換成...A123456789,並能同時檢核該 A123456789驗證是否正確!
請問該VB程式碼該如何建立(重點是小寫字母轉換成大寫...並一併驗證該身分證號碼輸入是否正確)
感恩各位先進能指導  ^^

TOP


水啦!!
太感謝二位先進的指導
疑惑點已獲得解決
感恩  ^^

TOP

回復 5# cypd

7樓已經說明

下列這行是控制要處理位置,[A:A] 表示A欄要處理
    If Intersect([A:A], Target) Is Nothing Then Exit Sub

若是 H5:H6要處理,修改如下
   If Intersect([H5:H6], Target) Is Nothing Then Exit Sub
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

dear  sir
  If Intersect([H5:H6], Target)    [H5:H6] 依需求變更即可

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect([H5:H6], Target) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    Target = UCase(Target)

    Application.EnableEvents = True

End Sub
羅

TOP

        靜思自在 : 難行能行,難捨能捨,難為能為,才能昇華自我的人格。
返回列表 上一主題