vba求援

sillykin

項目UserForm26.Show，要如何輸入完B37～B49往右下在輸入C37～C49......到M37~M49
項目UserForm12.Show，要如何輸入完B50～B54往右下在輸入C50～C54......到P50~P54
及身分證驗證

Kubi

回復 1# sillykin
提供 UserForm26 步驟請自行參考並撰寫(於確定鈕加入程式碼)：

1.點選 [確定] 鈕後，警告是否真的要將資料寫入工作表，若不是的話則退出程序，主要的用意是避免誤觸機制。
2.從第37列的最右欄往左找到有資料的欄(依你的範例是找到B欄)，再加1欄(依你的範例加1後是C欄)。
   程式碼： 定位欄 = Cells(37, Cells.Columns.Count).End(1).Column + 1
3.檢查該 [定位欄] 是否大於M欄，若是的話則警告"禁止再次寫入"訊息後退出程序。
4.將 UserForm26 內文字方塊的資料，依據 [定位欄] 的欄位，依序寫入工作表的儲存格內。
5.完成寫入後，清除 UserForm26 內的資料，做為準備下一筆的資料登錄作業。

上述第5項也可以用 Unload UserForm26 方法來關掉 UserForm26，因為 UserForm26 你並沒有另外結束或退出的按鈕。

而 UserForm12 之作法亦如上。

sillykin

回復 2# Kubi


    感謝回覆...
但試了還是不行,可能是自身能力不太好

GBKEE

回復 3# sillykin

試試看

1. Private Sub TextBox3_Change()
   
2.     Dim Msg As Boolean
   
3.     '基本身分證驗證，
   
4.             '1.為要10碼 -> Len(TextBox3) = 10
   
5.             '2 第一碼為英文字母後9碼全為數字 ->TextBox3.Text Like "[A-z]#########"
   
6.             
   
7.    '**** 但實際上政府有身分證的驗證規則 *****
   
8.     Msg = Len(TextBox3) = 10 And TextBox3.Text Like "[A-z]#########"   '其中一項不為真 Msg =False
   
9.     'Label18.為表單上,統一編號的Label控制項
   
10.     Label18.BackColor = IIf(Msg, &HFFFFC0, &HFF&)  '指定物件的背景色彩。
    
11.    
    
12. End Sub
    
13. 
    
14. Private Sub CommandButton2_Click()  '表單上資料輸入,請新增一按鈕,此按鍵紐的程式碼
    
15.     Dim Msg As String, Ar(), E As Variant, Rng As Range
    
16.     Ar = Array(TextBox2, TextBox3, TextBox4, TextBox5, TextBox6)  '控制項置入陣列
    
17.     '********防呆程式碼**********
    
18.     Msg = IIf(Label18.BackColor = &HFF&, "統一編號 有錯誤", "")
    
19.     For Each E In Ar
    
20.         If E = "" Then Msg = Msg & IIf(Msg <> "", vbLf, "") & "資料輸入不齊全": Exit For
    
21.     Next
    
22.     If Msg <> "" Then MsgBox Msg: Exit Sub
    
23.     Set Rng = Range("b50:P50")              '指定的位置
    
24.     E = Application.CountA(Rng)             '計算位置中有資料的個數
    
25.     '**指定位置,資料位置的檢查
    
26.     If E > 0 Then
    
27.         If E = Rng.Cells.Count Then MsgBox "資料已滿 ! 請檢查 ": Exit Sub  
    
28.         If Rng.Cells(E).Address <> Rng.Cells(Rng.Cells.Count).End(xlToLeft).Address Then MsgBox "資料位置有誤 ! 請檢查 ": Exit Sub
    
29.     End If
    
30.    
    
31.     '********防呆結束**********
    
32.     If MsgBox("確定 輸入資料!", vbYesNo) = vbNo Then Exit Sub
    
33.     '******資料輸入*************************************
    
34.     With Rng.Offset(0, E)
    
35.         .Resize(UBound(Ar) + 1, 1).Value = Application.WorksheetFunction.Transpose(Ar)
    
36.     End With
    
37. End Sub

複製代碼

sillykin

回復 4# GBKEE


    感謝G大的回覆
但要輸入到D50發生錯誤
身分證無法驗證...不知是否我放錯位置了嗎???
請大師指點

GBKEE

回復 5# sillykin

這行程式碼是錯誤多餘的請刪掉

1.       If Rng.Cells(Rng.Cells.Count).End(xlToLeft).Address <> Rng.Cells(1).Address Then MsgBox "資料位置有誤 ! 請檢查 ": Exit Sub

複製代碼

sillykin

回復 6# GBKEE


    謝謝G大的回覆
    巳刪除此條  If Rng.Cells(Rng.Cells.Count).End(xlToLeft).Address <> Rng.Cells(1).Address Then MsgBox "資料位置有誤 ! 請檢查 ": Exit Sub可正常運作
,但輸入身分證還是無法檢驗是否輸入正確與否?
是要在加入政府驗證程序嗎???
例如
      Private Sub Worksheet_Change(ByVal Target As Range) '借戶身分證檢查
Dim T, i%, S
With Target
      If .Count > 1 Then Exit Sub
      If Intersect([B51:P51], .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
小妹不才

GBKEE

回復 7# sillykin


   

1. Private Sub TextBox3_Change()
   
2.     Dim Msg As Boolean
   
3.     '基本身分證驗證，
   
4.             '1.為要10碼 -> Len(TextBox3) = 10
   
5.             '2 第一碼為英文字母後9碼全為數字 ->TextBox3.Text Like "[A-z]#########"
   
6.    '**** 但實際上政府有身分證的驗證規則 *****
   
7.     Msg = Len(TextBox3) = 10 And TextBox3.Text Like "[A-z]#########"   '其中一項不為真 Msg =False
   
8.     'Label18.為表單上,統一編號的Label控制項
   
9.     Label18.BackColor = IIf(Msg, &HFFFFC0, &HFF&)  '指定物件的背景色彩。
   
10.     If Msg Then 檢查碼
    
11. End Sub
    
12. Function 檢查碼() As Boolean      '身分證最後一碼檢查
    
13.     Dim T As String, I As Integer, S As Long
    
14.     T = InStr("ABCDEFGHJKLMNPQRSTUVXYWZIO", Left(TextBox3, 1)) + 9 & Mid(TextBox3, 2, 8)
    
15.     For I = 1 To 10
    
16.         S = S + Mid(T, I, 1) * Left(11 - I, 1)
    
17.     Next I
    
18.     T = Right(10 - Right(S, 1), 1)
    
19.      ' If T <> Mid(TextBox3, 10, 1) Then MsgBox "身份證字號錯誤！檢查碼：" & T
    
20.     Label18.BackColor = IIf(T <> Mid(TextBox3, 10, 1), &HFFFFC0, &HFF&)
    
21. End Function

複製代碼

sillykin

回復 8# GBKEE


    謝謝GBKEE耐心教導及指教
但小妹試了身分證輸入錯的身分證也一樣可輸入
而不會出現錯誤請更正
能否在請GBKEE大大能在指導一下嗎???