รบกวนเรื่องการบันทึกข้อมูลและการ Clear Checkbox

[niwat2811]

รบกวนเรื่องการบันทึกข้อมูลและการ Clear Checkbox คือต้องการให้ Sheet 2 บันทึกข้อมูลจาก Sheet1 ตามข้อมูลที่เรา CheckBox แล้วเรียงข้อมูลต่อกันลงมาเรื่อย
พร้อมทั้งเมื่อกดปุ่ม Clear Checkbox แล้วข้อมูลที่ Sheet 2 ไม่หายไปครับ รบกวนท่านอาจารย์ช่วยชี้แนะด้วยครับ

[bank9597]

ยังไม่มีเวลาดูให้เลย แต่เท่าที่ดูนั้น วิธีการดังกล่าวยังไม่ถูกต้องเพราะยังมีการ Count เพื่อให้ข้อมูลลงไปบันทึกต่อๆกันไปครับ

[niwat2811]

ครับที่ต้องการก็คือ ให้ CheckBox ข้อมูลที่ Sheet1 เมื่อเสร็จ 1 รายแล้วให้ไปเรียงต่อกันที่ Sheet2 ที่แถว Row2 แล้วก็กลับมาที่ Sheet1 แล้วก็ CheckBox ข้อมูลรายต่อไปโดยให้ข้อมูลไปต่อกันที่ Sheet2 แถว Row 3 ไปเรื่อย ๆ ครับ

[snasui]

ใน Sheet1 ไม่ใช่ CheckBox ครับ เป็น Object ประเภทรูปภาพ ไม่ได้เป็น Form Control หรือ ActiveX Control ที่จะนำไปเขียน Code ตามที่เขียนมาได้

การสร้าง CheckBox ควรเข้าไปที่เมนู Developer > Insert > ในหมวด Form Control เลือก CheckBox แล้วนำมาวาดใน Worksheet ตามตำแหน่งที่ต้องการ ลองแนบไฟล์มาใหม่ครับ

[niwat2811]

อาจารย์ครับได้ทำการแก้ไขไฟล์มาให้ใหม่แล้วครับ รบกวนช่วยชี้แนะให้ด้วยนะครับ ขอบคุณมากครับ

[snasui]

ลองตาม Code ด้านล่างครับ

Code: Select all

Sub SaveData()
    Dim rs As Range, rsAll As Range
    Dim rt As Range, i As Integer
    Set rsAll = Sheets("Sheet1").Range("D2:D10")
    Set rt = Sheets("Sheet2").Range("A" & Rows.Count) _
        .End(xlUp).Offset(1, 0)
    rt = Sheets("Sheet1").Range("A1")
    For Each rs In rsAll
        i = i + 1
        rt.Offset(0, i) = IIf(rs, 1, 0) 'Or rt.offset(0,i) = abs(rs)
    Next rs
End Sub

[niwat2811]

อาจารย์ครับรบกวนเรียนถามความหมายของ Code นี้หน่อยนะครับ เพื่อความเข้าใจเพิ่มขึ้น ขอบพระคุณมากครับ
For Each rs In rsAll
i = i + 1
rt.Offset(0, i) = IIf(rs, 1, 0) 'Or rt.offset(0,i) = abs(rs)
Next rs

[snasui]

เป็นการวน Loop โดยใช้ For Each Next ครับ ลองทำความเข้าใจตามด้านล่างครับ

จาก Code ที่ถามมาแปลได้ว่า ให้ดูที่ Range rsAll ไปทีละตัว โดยแต่ละตัวที่ว่านี้คือ rs ทุกครั้งที่เข้าถึง rs ก็ให้เพิ่มค่าตัวแปร i ไปทีละ 1 และกำหนดให้ ค่าที่ถัดจากตัวแปร rt ไปด้านขวาตามค่า i หมายถึงจะถัดไปเท่าใดก็ขึ้นอยู่กับค่า i ว่ามีค่าเท่าใด

โดยค่าที่ถัดไปทีว่านั้นให้ค่ามีค่าเท่ากับผลลัพธ์ทีได้จากสูตร Iff(rs,1,0) โดยสูตรนี้หมายความถึง หาก rs มีค่าเป็น True ก็ให้มีค่าเป็น 1 ถ้าเป็น False ก็มีค่าเป็น 0

[niwat2811]

รู้สึกเหมือนว่า Web มัน RollBack กลับไปครับอาจารย์ อาจารย์ครับจากที่ได้ทดลองนำ Code ไปประยุกต์ใช้ดูแล้ว ผู้ใช้หลายคนบอกว่าทำงานได้เร็วขึ้นมาก แต่ติดปัญหาอีกนิดนึงตรงที่เราไม่สามารถแก้ไขรายชื่อที่คีย์ผิดพลาดไปแล้วได้ เช่น ที่ Sheet2 แถว A2 ลูกค้าชื่อนาย A (ซึ่งจริง ๆ แล้วลูกค้าชื่อนาย K) ถ้าเราต้องการแก้ไขข้อมูลเราก็ไปค้นหาจาก Sheet1 ที่เซลล์ H1 พอค้นหาชื่อนาย A ขึ้นมาแล้วทำการแก้ไขให้เป็นนาย K เสร็จแล้วทำการ Save ปรากฎว่าระบบไม่ยอมไป Save ทับแทนที่นาย A กลับไป Save เพิ่มเป็นชื่อนาย K ในแถวที่ 7 ของ Sheet2 ครับ คือจริง ๆ แล้วอยากให้ไปเซพแทนที่ นาย A ซึ่งเป็นแถวที่ 2 ครับ รบกวนท่านอาจารย์ช่วยชี้แนะปรับ Code ให้ด้วยครับ ขอบพระคุณเป็นอย่างสูงครับ

[snasui]

ผมตอบเป็นหลักการให้แล้วกันนะครับ

การทำเช่นนั้นจะต้องหาว่าค่าที่ Search ได้มานั้นอยู่ในลำดับที่เท่าไรของฐานข้อมูล แล้วเก็บค่านั้นไว้เพื่อที่เวลา Edit จะได้กลับไปแก้ที่บรรทัดเดิม ลองปรับปรุง Code มาดูก่อนครับ ผมดูในไฟล์แล้วยังเป็น Code เดิม

[niwat2811]

อาจารย์ครับ ลองเพิ่ม Code แล้ว ปรากฏว่าไปแก้ไขชื่อที่ Sheet2 ทุกแถวเลยครับ รบกวนท่านอาจารย์ช่วยดูให้หน่อยนะครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่าง โดยประกาศตัวแปร lng ไว้บนสุดเพื่อใช้กับ Procedure FindData และ Procedure EditData ตามด้านล่างครับ

Code: Select all

Dim lng As Long

Sub SaveData()
    Dim rs As Range, rsAll As Range
    Dim rt As Range, i As Integer
    Dim j As Integer
    Set rsAll = Sheets("Sheet1").Range("D2:D10")
    Set rt = Sheets("Sheet2").Range("A" & Rows.Count) _
        .End(xlUp).Offset(1, 0)
    If Application.CountIf(Sheets("Sheet2").Range("A:A"), Sheets("Sheet1").Range("A1")) > 0 Then
        j = MsgBox("คุณกำลังบันทึกข้อมูลซ้ำ คุณต้องการแก้ไขข้อมูลใช่หรือไม่?", vbYesNo)
        If j = vbYes Then
            Call EditData
            Exit Sub
        Else
            Exit Sub
        End If
    End If
    rt = Sheets("Sheet1").Range("A1")
    For Each rs In rsAll
        i = i + 1
        rt.Offset(0, i) = IIf(rs, 1, 0)
    Next rs
    MsgBox "บันทึกข้อมูลเรียบร้อยแล้ว"
End Sub

Sub ClearCheckbox()
    Range("A1,D:D,H1").ClearContents
End Sub

Sub FindData()
    Dim lCount As Long
    Dim rsSearch As Range, r As Range
    Dim rt As Range, rs As Range
    With Sheets("Sheet1")
        Set rsSearch = .Range("H1")
        Set rs = .Range("D2:D10")
    End With
    lCount = Application.CountIf( _
        Sheets("Sheet2").Range("A:A"), rsSearch)
    If lCount > 0 Then
        With Sheets("Sheet2")
        lng = Application.Match(rsSearch, _
            Sheets("Sheet2").Range("A:A"), 0)
        End With
    Else
        MsgBox "Can't find your data."
        Exit Sub
    End If
    Set rt = Sheets("Sheet2").Range("B" & lng).Resize(1, 9)
    rt.Copy
    Sheets("Sheet1").Range("D2").PasteSpecial xlPasteValues, _
        Transpose:=True
    Sheets("Sheet1").Range("A1") = rt.End(xlToLeft)
    For Each r In rs
        r = IIf(r = 1, True, False)
    Next r
    Application.CutCopyMode = False
End Sub
Sub EditData()
    Dim rs As Range, rsAll As Range
    Dim rt As Range, i As Integer
    Set rsAll = Sheets("Sheet1").Range("D2:D10")
    Set rt = Sheets("Sheet2").Range("A" & lng)
    rt = Sheets("Sheet1").Range("A1")
    For Each rs In rsAll
        i = i + 1
        rt.Offset(0, i) = IIf(rs, 1, 0)
    Next rs
    Range("A1,H1").ClearContents
    MsgBox "แก้ไขข้อมูลเรียบร้อยแล้ว"
End Sub

[niwat2811]

อาจารย์ครับลองนำ Code ด้านบนไปวางทับ Code ทั้งหมดแล้วครับ ผลปรากฎว่าไปบันทึกเพิ่มที่ Sheet 2 แถวสุดท้าย ซึ่งจริง ๆ แล้วต้องการให้บันทึกแทนแถวที่เราค้นหาครับ

[snasui]

มีวิธีการทำงานอย่างไรถึงบันทึกแถวสุดท้ายครับ ปกติการจะแก้ไขต้อง Search ขึ้นมาก่อนหรือไม่ครับ

สำหรับ Code ที่ปรับให้ไป จะมีการ Search ขึ้นมาก่อน โปรแกรมจะเก็บค่าบรรทัดของข้อมูลไว้ และเมื่อคลิก Edit ก็จะเก็บลงไปยังบรรทัดเดิม

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

[niwat2811]

ครับ ผมต้องขอโทษท่านอาจารย์ด้วยครับที่ไม่ได้ทดสอบให้เรียบร้อยก่อน ขั้นตอนเมื่อก่อนหน้านี้ผมทำการแก้ไขแล้วไปกดปุ่ม Save แทนที่จะกดปุ่ม Edit ต้องขอโทษท่านอาจารย์และขอบพระคุณเป็นอย่างสูงที่ช่วยชี้แนะครับ ขอบคุณมากครับ

[niwat2811]

ได้ลองนำ Code มาประยุกต์ใช้ในงานแล้วยังพบปัญหาคือ ถ้าเรียกข้อมูลขึ้นมาแก้ไขแล้วต้องการให้บันทึกกลับไปที่เดิมเกิด Error ขึ้นมาครับ รบกวนท่านอาจารย์ช่วยดูให้หน่อยนะครับ

[snasui]

ตรง Sub FindData() ให้ลบ Dim lng as Long ออกไปครับ เนื่องจากประกาศไว้บนสุดแล้ว จากนั้นลอง Run Code ใหม่ดูอีกรอบ สังเกต Code ที่ผมเขียนไปให้ในความเห็นก่อนนี้จะเห็นว่าผมลบออกให้แล้ว

[niwat2811]

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