จัดเก็บข้อมูลลงฐานข้อมูลไม่ได้

[tutape]

ผมได้ลองปรับสูตรในการบันทึกข้อมูลด้วย VBA และดึงข้อมูลมาแก้ไขแล้วจัดเก็บแทนที่ หากรหัสในเซลล์ C3 ในชีท deberk ไม่ซ้ำรหัสเดิมก็จะมีการบันทึกเพิ่ม แต่ถ้าหากรหัสซ้ำก็จะเป็นการแก้ไขข้อมูล แต่มีปัญหาตรงที่ว่าเมื่อคลิ๊กปุ่มบันทึกรายการพัสดุในชีท deberk หากเป็นรหัสใหม่รายการไม่บันทึกต่อจากแถวสุดท้ายให้ โดยโค้ดที่ผมใช้เป็นดังนี้ครับ

Code: Select all

Sub changeData_deberk()  'คลิกปรับปรุงข้อมูล  แก้ไขแล้วบันทึกซ้ำ
   If Range("g3") = "" Then Exit Sub
            If Sheets("DBberk").Columns("f:f").Find(Range("g3"), LookIn:=xlValues) Is Nothing Then
    Range("C4:g4").Select
    Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("DBberk").Cells(65536, "b").End(xlUp) _
            .Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        'เรียงเสร็จเป็นช่องว่าง
  Worksheets("deberk").Range("c4:f503") = ""
   Application.CutCopyMode = False
    Sheets("deberk").Select
    Range("c4").Select
    MsgBox "ระบบจัดเก็บข้อมูลเรียบร้อยแล้ว", 38, "โปรแกรมรายงานเอกสารพัสดุ :                    "
            Else
            i = Sheets("DBberk").Columns("f:f").Find(Range("g4"), LookIn:=xlValues).Row
   Range("C4:g4").Select
    Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("DBberk").Range("b" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.CutCopyMode = False
       'เป็นช่องว่าง
       
           Range("B4:F1048576").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.ClearContents
    Range("B4").Select
       
       
           Worksheets("deberk").Range("c4:f503") = ""
    Sheets("find_deberk").Select
    Range("b1").Select
    MsgBox "ระบบแก้ไขข้อมูลเรียบร้อยแล้ว", 38, "โปรแกรมรายงานเอกสารพัสดุ :                     "
    Dim iRet As Integer
    Dim strPrompt As String
    Dim strTitle As String
     ' Promt
    strPrompt = "พิมพ์เอกสารเลยหรือไม่ ?"
     ' Dialog's Title
    strTitle = "โปรแกรมรายงานเอกสารพัสดุ :                    "
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbYesNo, strTitle)
    ' Check pressed button
    If iRet = vbNo Then
    Else
        Sheets("pberk").Select
         Range("bc3").Select
        End If
End If
End Sub

รบกวนขอคำแนะนำด้วยครับ

[snasui]

ช่วยเล่ามาว่ามีขั้นตอนอย่างไร ต้องกรอกข้อมูลชีทใด เซลล์ใด ด้วยค่าใด ปัญหาคืออะไร ต้องการคำตอบเป็นอย่างไร Code ที่เขียนมาติดขัดบรรทัดใดครับ

[tutape]

คีย์ข้อมูลลงในชีท deberk ซึ่งเลขรหัสในเซลล์ g3 ลิ้งค์มาจากชีท databerk เซลล์ e3
โดยในชีท deberk จะคีย์ข้อมูลในคอลัมน์ c ถึง f แล้วเมื่อคลิ๊กปุ่ม บันทึกรายการพัสดุ จะนำข้อมูลในชีท deberk ไปจัดเก็บในชีท DBberk
แต่พอรันแมโครข้อมูลจะไปปรากฎที่แถว 518 ซึ่งไม่ต่อจากข้อมูลที่มีอยู่เดิม คือ แถว 19

[snasui]

ให้ลบข้อมูลในชีท DBberk ตั้งแต่แถว 20 จนถึงแถวล่างสุดทิ้งไปก่อนครับ

ตัวอย่างการปรับ Code

Code: Select all

Sub changeData_deberk()  'คลิกปรับปรุงข้อมูล  แก้ไขแล้วบันทึกซ้ำ
    Dim target As Range
    With Sheets("DBberk")
        Set target = .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With
    If Range("g3") = "" Then Exit Sub
    If Sheets("DBberk").Columns("f:f").Find(Range("g3"), LookIn:=xlValues) Is Nothing Then
        Range("C4", Range("g" & Rows.Count).End(xlUp)).Select
        Selection.Copy
        target.PasteSpecial xlPasteValues
            'เรียงเสร็จเป็นช่องว่าง
        Worksheets("deberk").Range("c4:f503") = ""
        Application.CutCopyMode = False
        Sheets("deberk").Select
        Range("c4").Select
        MsgBox "ระบบจัดเก็บข้อมูลเรียบร้อยแล้ว", 38, "โปรแกรมรายงานเอกสารพัสดุ :                    "
    Else
        i = Sheets("DBberk").Columns("f:f").Find(Range("g4"), LookIn:=xlValues).Row
        Range("C4:g4").Select
        Range("C4", Range("g" & Rows.Count).End(xlUp)).Select
        Selection.Copy
        target.PasteSpecial xlPasteValues
'Other code
End Sub

[tutape]

ให้ลบข้อมูลในชีท DBberk ตั้งแต่แถว 20 จนถึงแถวล่างสุดทิ้งไปก่อนครับ

ตัวอย่างการปรับ Code

Code: Select all

Sub changeData_deberk()  'คลิกปรับปรุงข้อมูล  แก้ไขแล้วบันทึกซ้ำ
    Dim target As Range
    With Sheets("DBberk")
        Set target = .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With
    If Range("g3") = "" Then Exit Sub
    If Sheets("DBberk").Columns("f:f").Find(Range("g3"), LookIn:=xlValues) Is Nothing Then
        Range("C4", Range("g" & Rows.Count).End(xlUp)).Select
        Selection.Copy
        target.PasteSpecial xlPasteValues
            'เรียงเสร็จเป็นช่องว่าง
        Worksheets("deberk").Range("c4:f503") = ""
        Application.CutCopyMode = False
        Sheets("deberk").Select
        Range("c4").Select
        MsgBox "ระบบจัดเก็บข้อมูลเรียบร้อยแล้ว", 38, "โปรแกรมรายงานเอกสารพัสดุ :                    "
    Else
        i = Sheets("DBberk").Columns("f:f").Find(Range("g4"), LookIn:=xlValues).Row
        Range("C4:g4").Select
        Range("C4", Range("g" & Rows.Count).End(xlUp)).Select
        Selection.Copy
        target.PasteSpecial xlPasteValues
'Other code
End Sub

รบกวนอีกครั้งครับ พอผมเอาโค้ดไปใช้ในระบบงานจริงยังไม่ได้ครับ และที่ อ. บอกว่าให้ลบข้อมูลในชีท DBberk ตั้งแต่แถว 20 จนถึงแถวล่างสุดทิ้งไปก่อน ผลลองนั่งแกะโค้ด คือโค้ดนี้หรือไม่ครับ หรือว่าต้องเข้าไปเลือกและลบเอง

Code: Select all

With Sheets("DBberk")
        Set target = .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With

[snasui]

และที่ อ. บอกว่าให้ลบข้อมูลในชีท DBberk ตั้งแต่แถว 20 จนถึงแถวล่างสุดทิ้งไปก่อน ผลลองนั่งแกะโค้ด คือโค้ดนี้หรือไม่ครับ หรือว่าต้องเข้าไปเลือกและลบเอง

ให้ลบเองด้วย Manual เพราะเป็นการลบครั้งเดียว ที่ต้องลบเพราะมีค่าที่เป็นอุปสรรคต่อการวางข้อมูล เป็นค่าเกิดจากการทดสอบจึงจำเป็นต้อง Clear ทิ้งครับ

[tutape]

และที่ อ. บอกว่าให้ลบข้อมูลในชีท DBberk ตั้งแต่แถว 20 จนถึงแถวล่างสุดทิ้งไปก่อน ผลลองนั่งแกะโค้ด คือโค้ดนี้หรือไม่ครับ หรือว่าต้องเข้าไปเลือกและลบเอง

ให้ลบเองด้วย Manual เพราะเป็นการลบครั้งเดียว ที่ต้องลบเพราะมีค่าที่เป็นอุปสรรคต่อการวางข้อมูล เป็นค่าเกิดจากการทดสอบจึงจำเป็นต้อง Clear ทิ้งครับ

แล้วจะสูตรหรือ VBA ให้ลบเองได้ป่าว หรือว่าจะต้องเข้าไปลบเองวิธีเดียวเท่านั้น หรือมีแนวทางอื่นหรือไม่ครับ ไม่อย่างนั้นทำทุกครั้งก็ต้องเข้าลบทุกครั้ง
รบกวรแนะแนวทางด้วยครับ

[snasui]

เหตุใดต้องลบทุกครั้งครับ อ่านที่ผมตอบและเข้าใจตามนั้นหรือไม่ครับ

[tutape]

เหตุใดต้องลบทุกครั้งครับ อ่านที่ผมตอบและเข้าใจตามนั้นหรือไม่ครับ

งงๆ ครับ

[snasui]

งงข้อความใด ยกมาถามเลยครับ

[tutape]

ผมใช้วิธีการแบบนี้ถูกหรือไม่ครับ
กด "f5" เลือก "แบบพิเศษ" เลือก "ที่ว่าง" แล้วกดปุ่ม del บนคีย์บอร์ด พร้อมบันทึกแมโคร
แล้วค่อยนำแมโครไปประยุกต์ใช้

[snasui]

ไม่จำเป็นครับ ผมแจ้งไว้อย่างชัดเจนแล้วว่าเป็นการลบเพียงครั้งเดียวเท่านั้น หลังจากนั้นก็ไม่จำเป็นต้องลบ ยกเว้นว่าเขียน Code ไม่ถูกต้อง

[tutape]

ผมลองปรับแล้วครับ แต่ที่ไม่ได้เพราะในไฟล์งานจริง ผมเขียนโค้ดให้ copy เป็นช่วงของข้อมูล เช่น C4:g500
แต่ถ้าจะลองเปลี่ยนรูปแบบหรือลักษณะในเก็บฐานข้อมูลละครับ อาจารย์พอจะแนะนำแนวทางได้หรือไม่ครับ
หรือจะแก้ไขโค้ดให้เลือกเฉพาะช่วงที่มีข้อมูล

[snasui]

ควรทำไฟล์ตัวอย่างเลียนแบบงานจริงแล้วนำไฟล์นั้นมาถาม จะได้เห็นว่าสภาพแวดล้อมการทำงานเป็นอย่าไร

การนำข้อมูลไปวางในฐานข้อมูลควรนำไปเฉพาะที่มีข้อมูล ไม่มีความจำเป็นใดที่จะต้อง Copy เผื่อ เช่นมีข้อมูล 10 บรรทัดก็ให้ Copy ไปแค่ 10 บรรทัด มี 1000 บรรทัดก็ Copy ไป 1000 บรรทัด ไม่ใช่มี 10 บรรทัดแต่ Copy เผื่อไปเป็น 1000 บรรทัดครับ