vba求援

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

2^#

發表於 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 之作法亦如上。

帖子: 169
主題: 41
精華: 0
積分: 219
點名: 0
作業系統: WIN10
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-7-31
最後登錄: 2023-9-15

3^#

發表於 2017-3-11 13:02 | 只看該作者

回復 2# Kubi

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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2017-3-11 16:53 | 只看該作者

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

回復 3# sillykin

試試看

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 169
主題: 41
精華: 0
積分: 219
點名: 0
作業系統: WIN10
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-7-31
最後登錄: 2023-9-15

5^#

發表於 2017-3-11 22:51 | 只看該作者

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

回復 4# GBKEE

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

資料有誤.JPG (150.77 KB)

表單輸入格式.rar (60.68 KB)

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2017-3-12 07:48 | 只看該作者

回復 5# sillykin

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

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 169
主題: 41
精華: 0
積分: 219
點名: 0
作業系統: WIN10
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-7-31
最後登錄: 2023-9-15

7^#

發表於 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

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2017-3-12 14:58 | 只看該作者

回復 7# sillykin

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 169
主題: 41
精華: 0
積分: 219
點名: 0
作業系統: WIN10
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-7-31
最後登錄: 2023-9-15

9^#

發表於 2017-3-12 15:19 | 只看該作者

[版主管理留言]

GBKEE(2017/3/12 20:12): 檢查身分證最後一碼的邏輯我不清楚.

回復 8# GBKEE

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