สอบถาม CodeVB ส่งข้อมูลจาก Form ลงตารางในชีท

[tigerwit]

จากไฟล์ที่แนบมา ต้องการบันทึกข้อมูลใน Forms ชื่อ FrmCustomer ลงชีท Custommer
โดยใช้ Code

Code: Select all

Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
With FrmCustomer

If .txtcus1.Value = "" Then
    MsgBox "กรุณากรอกข้อมูลให้ครบ"
    .txtcus1.SetFocus
Exit Sub
    End If
If .txtcus2.Value = "" Then
    MsgBox "กรุณากรอกข้อมูลให้ครบ"
    .txtcus2.SetFocus
Exit Sub
    End If
End With

    Set sh = ThisWorkbook.Sheets("Customer")
    iRow = [Counta(Customer!D:D)] + 1
With sh
    .Cells(iRow, 4) = iRow - 1
    .Cells(iRow, 5) = FrmCustomer.txtcus1.Value
    .Cells(iRow, 6) = FrmCustomer.txtcus2.Value
End With
Reset
MsgBox "เพิ่มรายชื่อ ร้าน/หจก.ใหม่ เรียบร้อยแล้ว"
End Sub

และเรียกข้อมูลมาลบ โดย Code

Code: Select all

Private Sub CommandButton7_Click() 'ลบข้อมูลที่เลือก
    If Trim(Me.txtId.Value) = "" Then
        MsgBox "คุณยังไมีเลือกผู้ประกอบการร้านค้าที่จะลบข้อมูล"
        Exit Sub
    End If
    answer = MsgBox("คุณต้องการลบข้อมูลผู้ประกอบการนี้ใช่หรือไม่??", vbQuestion + vbYesNo, "warning")
    If answer = vbYes Then
            Dim sh As Worksheet
            Set sh = ThisWorkbook.Sheets("Customer")
            Dim Delete_Row As Long
            Delete_Row = Application.WorksheetFunction.Match(CLng(Me.txtId.Value), sh.Range("D:D"), 0)
            sh.Range("A" & Delete_Row).EntireRow.Delete
        Reset
    CommandButton4.Enabled = False
    CommandButton7.Enabled = False
    CommandButton1.Enabled = True
    End If
End Sub

แต่มีปัญหาตอนลบ ตรง ID ที่เป็นตัวเลข ถ้ามีจำนวนหลายแถว เช่น มี 6 แถว Id เป็น 1 2 3 4 5 6 แล้วเราลบ แถวแรก Id 1
ต่อมาเมื่อเราเพิ่มรายการเข้าไปใหม่ 1 รายการ Id จะเป็น 2 ซึ่งที่ต้องการคือ ต้องการให้ id ที่เพิ่มใหม่ เป็นเลขที่ต่อจาก id ที่มีค่าสูงสุดใน คลอลัมน์ D 
ต้องปรับ โค๊ดอย่างไรครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

    Dim sh As Worksheet
    Dim iRow As Long, fbr As Long
    With FrmCustomer
        
        If .txtcus1.Value = "" Then
            MsgBox "กรุณากรอกข้อมูลให้ครบ"
            .txtcus1.SetFocus
        Exit Sub
            End If
        If .txtcus2.Value = "" Then
            MsgBox "กรุณากรอกข้อมูลให้ครบ"
            .txtcus2.SetFocus
            Exit Sub
        End If
    End With
    
    Set sh = ThisWorkbook.Sheets("Customer")
    '    iRow = [Counta(Customer!D:D)] + 1
    With sh
        fbr = .Range("d" & .Rows.Count).End(xlUp).Row + 1
        If .Range("d2").Value = "" Then
            iRow = 1
        Else
            iRow = .Range("d" & .Rows.Count).End(xlUp).Value + 1
        End If
        .Cells(fbr, 4) = iRow
        .Cells(fbr, 5) = FrmCustomer.txtcus1.Value
        .Cells(fbr, 6) = FrmCustomer.txtcus2.Value
    End With
    'With sh
    
    'End With
    Reset
    MsgBox "เพิ่มรายชื่อ ร้าน/หจก.ใหม่ เรียบร้อยแล้ว"

[tigerwit]

ขอบคุณครับ