標題: [發問] 身分證代碼 [打印本頁]

---

作者: cypd    時間: 2016-1-3 15:34     標題: 身分證代碼

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

---

作者: sujane0701    時間: 2016-1-4 00:49

=UPPER(A1)

---

作者: sujane0701    時間: 2016-1-4 01:03

抱歉,沒注意到要在同一儲存格~

---

作者: ML089    時間: 2016-1-4 09:44

回復 1# cypd
同一格要改變無法用公式，需要用VBA
按 ALT-F11，將VBA放入

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Intersect([A:A], Target) Is Nothing Then Exit Sub
   
3.     Application.EnableEvents = False
   
4.     Target = UCase(Target)
   
5.     Application.EnableEvents = True
   
6. End Sub

複製代碼

[attach]23035[/attach]

---

作者: cypd    時間: 2016-1-4 14:35

本帖最後由 cypd 於 2016-1-4 14:37 編輯

回復 4# ML089
感恩版主ML089解惑
若是儲存格位置不固定
其公式程式碼是否要做修改?
感恩您!!^^

---

作者: cypd    時間: 2016-1-4 15:19

回復 5# cypd
附上範例
若是 H5、H6儲存格要轉換...
其程式碼該如何...
感恩版主ML089能再度解惑

---

作者: rouber590324    時間: 2016-1-4 16:17

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

---

作者: ML089    時間: 2016-1-4 17:59

回復 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

---

作者: cypd    時間: 2016-1-4 19:03


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

---

作者: cypd    時間: 2016-1-5 20:39     標題: 身分證檢核

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

---

作者: stillfish00    時間: 2016-1-6 10:53

回復 1# cypd
你要先說明身分證的檢核規則。

---

作者: 准提部林    時間: 2016-1-6 15:48

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

---

作者: cypd    時間: 2016-1-7 01:15

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

---

作者: sillykin    時間: 2017-2-27 15:44

回復 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要如何加入呢???

---

作者: sillykin    時間: 2017-2-27 23:18

回復 14# sillykin


    巳解決

---

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