Board logo

標題: vba求援 [打印本頁]
作者: sillykin    時間: 2017-3-9 22:52     標題: vba求援

項目UserForm26.Show，要如何輸入完B37∼B49往右下在輸入C37∼C49......到M37~M49
項目UserForm12.Show，要如何輸入完B50∼B54往右下在輸入C50∼C54......到P50~P54
及身分證驗證
作者: Kubi    時間: 2017-3-10 14:36

回復 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    時間: 2017-3-11 13:02

回復 2# Kubi


    感謝回覆...
但試了還是不行,可能是自身能力不太好
作者: GBKEE    時間: 2017-3-11 16:53

本帖最後由 GBKEE 於 2017-3-12 07:46 編輯

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

  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    時間: 2017-3-11 22:51

本帖最後由 sillykin 於 2017-3-11 22:53 編輯

回復 4# GBKEE


    感謝G大的回覆
但要輸入到D50發生錯誤
身分證無法驗證...不知是否我放錯位置了嗎???
請大師指點
作者: GBKEE    時間: 2017-3-12 07:48

回復 5# sillykin

這行程式碼是錯誤多餘的請刪掉
  1.       If Rng.Cells(Rng.Cells.Count).End(xlToLeft).Address <> Rng.Cells(1).Address Then MsgBox "資料位置有誤 ! 請檢查 ": Exit Sub
複製代碼
作者: sillykin    時間: 2017-3-12 11:23

本帖最後由 sillykin 於 2017-3-12 11:26 編輯

回復 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    時間: 2017-3-12 14:58

回復 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    時間: 2017-3-12 15:19

回復 8# GBKEE


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



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