Snasui Excel Forum

คือว่าเวลา รหัสซ้ำ มันก็จะขึ้น msgbox รหัสซ้ำ ให้ แต่พอไม่ซ้ำมันก็ค้างไปเลยนะครับ รบกวนด้วยนะครับ

Option Explicit
Const db_sheet = "db_student"
Const name_col = 1, surname_col = 2
Const sex_col = 3, id_col = 4
Const ncar_col = 5, lineway_col = 6

Public Sub entry_mode()

Dim blank_row As Single

blank_row = Worksheets(db_sheet).Cells(1, 1).End(xlDown).Row + 1

With Worksheets(db_sheet)

.Cells(blank_row, name_col).Value = entry_form.name_txtbox.Value
.Cells(blank_row, surname_col).Value = entry_form.surname_txtbox.Value
.Cells(blank_row, sex_col).Value = entry_form.sex_cbbox.Value
.Cells(blank_row, id_col).Value = entry_form.id_txtbox.Value
.Cells(blank_row, ncar_col).Value = entry_form.ncar_txtbox.Value
.Cells(blank_row, lineway_col).Value = entry_form.lineway_cbbox.Value

End With


MsgBox "Database updated", vbInformation, "Student Record"
entry_form.name_txtbox.Text = ""
entry_form.surname_txtbox = ""
entry_form.sex_cbbox = ""
entry_form.id_txtbox = ""
entry_form.ncar_txtbox = ""
entry_form.lineway_cbbox = ""



End Sub

Public Sub search_mode()
Dim id_search As String
Dim id_check As String
Dim data_row As Single
Dim i As Single

id_search = entry_form.id_txtbox.Value
data_row = 2
id_check = Worksheets(db_sheet).Cells(data_row, id_col).Value

With Worksheets(db_sheet)

Do Until id_check = id_search

data_row = data_row + 1
id_check = Worksheets(db_sheet).Cells(data_row, id_col).Value
Loop

End With
With entry_form
.name_txtbox.Value = Worksheets(db_sheet).Cells(data_row, name_col).Value
.surname_txtbox.Value = Worksheets(db_sheet).Cells(data_row, surname_col).Value
.sex_cbbox.Value = Worksheets(db_sheet).Cells(data_row, sex_col).Value
.id_txtbox.Value = Worksheets(db_sheet).Cells(data_row, id_col).Value
.ncar_txtbox.Value = Worksheets(db_sheet).Cells(data_row, ncar_col).Value
.lineway_cbbox.Value = Worksheets(db_sheet).Cells(data_row, lineway_col).Value
End With
End Sub

Public Sub search_mode2()
Dim name_search As String
Dim name_check As String
Dim name_row As Single
Dim n As Single

name_search = entry_form.name_txtbox.Value
name_row = 2
name_check = Worksheets(db_sheet).Cells(name_row, name_col).Value

With Worksheets(db_sheet)

Do Until name_check = name_search

name_row = name_row + 1
name_check = Worksheets(db_sheet).Cells(name_row, name_col).Value
Loop

End With

With entry_form
.name_txtbox.Value = Worksheets(db_sheet).Cells(name_row, name_col).Value
.surname_txtbox.Value = Worksheets(db_sheet).Cells(name_row, surname_col).Value
.sex_cbbox.Value = Worksheets(db_sheet).Cells(name_row, sex_col).Value
.id_txtbox.Value = Worksheets(db_sheet).Cells(name_row, id_col).Value
.ncar_txtbox.Value = Worksheets(db_sheet).Cells(name_row, ncar_col).Value
.lineway_cbbox.Value = Worksheets(db_sheet).Cells(name_row, lineway_col).Value
End With


End Sub

Public Sub rsearch_mode()
Dim id_rsearch As String
Dim id_rcheck As String
Dim data_rrow As Single
Dim r As Single

id_rsearch = entry_form.id_txtbox.Value
data_rrow = 2
id_rcheck = Worksheets(db_sheet).Cells(data_rrow, id_col).Value

With Worksheets(db_sheet)

Do Until id_rcheck = id_rsearch

data_rrow = data_rrow + 1
id_rcheck = Worksheets(db_sheet).Cells(data_rrow, id_col).Value
Loop
MsgBox "รหัสซ้ำ"

End With


End Sub

ควรแนบไฟล์และคำอธิบายมาครับ หากเอาโค๊ดมาแป๊ะไว้แบบนี้ไม่สามารถทดสอบได้ครับ

การโพสต์ Code ช่วยปรับให้แสดงเป็น Code ด้วยครับ สามารถดูตัวอย่างได้จากกระทู้นี้ครับ viewtopic.php?f=6&t=1187