การดึงข้อมูลจาก database มาแสดงบนฟอร์ม

[bank9597]

ก่อนอื่นต้องถามอาจารย์ก่อนว่า เราจะสามารถดึงข้อมูลมาจาก Database มาแสดงบนฟอร์มที่เราเตรียมไว้แล้วได้หรือไม่
จากที่เคยทำมา เราจะดึงข้อมูลมาแสดงในแกนเดียวกันตลอด (แนวตั้งและแนวนอน) แต่ในครั้งนี้เราจะดึงข้อมูลจากแกนแนวนอนมาแสดงในฟอร์มที่เป็นแนวตั้ง

การเขียนโค๊ดบันทึกข้อมูลไปยัง Database เราต้องมีชีท temp ไว้จัดเรียงข้อมูลให้พร้อมก่อนจะบันทึกไปยัง database ทำให้สะดวกในการเขียนโค๊ด

แต่คราวนี้ผมจะดึงข้อมูลจาก Database มาแสดงในฟอร์ม สั่งซื้อ เลย ไม่ทราบว่าเราต้องมีชีท Temp อีกไหมครับ

ตัวงาน
คือต้องการทำใบสอบราคา บันทึกข้อมูลไปเก็บไว้ใน QOData หลังจากตัดสินใจสั่งซื้อแล้ว เราก็ดึงข้อมูลจาก QOData ไปยัง Purchase Order เพื่อทำการสั่งซื้อต่อไป โดยใน Purchase Order เราสามารถ,ลบ รายการได้ สมมุติสอบราคาไป 10 รายการ แต่ซื้อจริงแค่ 9 รายการ และเมื่อดึงข้อมูลมาแล้ว ถูกใช้งานแล้ว ข้อมูลใน QOData ก็จะถูกลบไปเมื่อมีการสั่งซื้อแล้ว (ลบทิ้งไป เหมาะหรือไม่)

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

[snasui]

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

ขอเพิ่มเติมกรณีการทำชีท Temp เพื่อรับข้อมูลจาก Form ลงไปบันทึกใน Database ว่า เราไม่จำเป็นต้องทำชีท Temp ครับ เพียงแต่ถ้ามีชีท Temp จะช่วยให้เราสะดวกในการใช้งาน ลดความซับซ้อนของ Code ลงได้มาก เนื่องจากแนวการวางข้อมูล หรือ Field ที่เรารับข้อมูลจาก Form จะอยู่แบบกระจัดกระจายเสียเป็นส่วนใหญ่ครับ

[bank9597]

รายงานผลนิดนึงครับ ตอนนี้ยังไม่คืบหน้าเลยครับ ผมยังหาวิธีดึงข้อมูลมาแสดงบนฟอร์มไ่ม่ได้เลย เคยดูตัวอย่างการดึงข้อมูลแบบเก่า (ต้นทางปลายทางมีรูปแบบเหมือนกัน)

แต่พอมาดึงแบบให้ข้อมูลแยกจัดเรียงตามช่องบนฟอร์ม ยอมรับว่าเป็นงานยากมากเลยครับ เมื่อคืนก็นอนตี 1 อิอิ

ยังไงจะพยายามต่อครับ เดี๋ยวจะขอขึ้นกระทู้ใหม่เรื่องการ Save ข้อมูลจาก Form ที่สร้างจาก Vba มาบันทึกลงในชีทครับ

[bank9597]

อาจารย์ ต้องยอมแพ้ครับ ผมปรับสูตรไม่ได้จริงๆ ยังไงผมก็อยากดูตัวอย่างก่อนครับถึงจะทำได้

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

ฟอร์มรับข้อมูลอยู่ใน ชีท Form ครับ ดึงข้อมูลมาจากชีท Data
ส่วนโมดูลที่ใช้ดึงคือ โมดูลที่ 3 ครับ

ขอบคุณมากครับ

Form.xlsm

[snasui]

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

ลองดู Code ตัวอย่างด้านล่าง เป็นการนำข้อมูลในชีท Data มาวางในชีท Form โดยไม่คำนึงถึงหัว Field เนื่องจากควรที่จะมีช่อง Name เพียงช่องเดียว

Code: Select all

Sub PullToEdit()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Set rFind = Sheets("Form").Range("I7")
    If Sheets("Form").Range("I7") = "" Then Exit Sub
    With Sheets("Data")
        Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("ไม่มีเลข PO นี้")
            Exit Sub
        End If
    End With
    For Each r In rDataAll
        If r = rFind Then
            Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
                .Offset(1, 0)
            r.Offset(0, 2).Resize(1, 4).Copy
            rTarget.PasteSpecial xlPasteValues
        End If
        With Sheets("Form")
            .Range("C3") = r: .Range("F3") = r.Offset(0, 1)
        End With
    Next r
    Application.CutCopyMode = False
    MsgBox "Get data has finished."
End Sub

[bank9597]

ที่อาจารย์ทำมาให้ดูเป็นตัวอย่างถือว่าดีมากเลยครับ

ขอบคุณน่ะครับ เดี๋ยวผมจะเอาไปปรับใช้ด้วยตัวเองดูครับ

ลืมไปครับ ขออภัยด้วยครับที่ไม่ทำตัวอย่างให้ชัดเจน

[bank9597]

อาจารย์ครับ

มันมีปัญหาอยู่ครับ คือว่าช่องที่ใส่ชื่อบริษัทยังไม่ถูกต้องครับ ส่วนข้อมูลอื่นๆ ถูกต้องแล้วครับ

ผมได้ใส่ข้อมูลไว้เป็นตัวอย่างแล้วครับ

Form.xlsm

[snasui]

ปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub PullToEdit()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Set rFind = Sheets("Form").Range("F4")
    If Sheets("Form").Range("F4") = "" Then Exit Sub
    With Sheets("Data")
        Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("äÁèÁÕàÅ¢ QO ¹Õé")
            Exit Sub
        End If
    End With
    For Each r In rDataAll
        If r = rFind Then
            Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
                .Offset(1, 0)
            r.Offset(0, 2).Resize(1, 3).Copy
            rTarget.PasteSpecial xlPasteValues
            With Sheets("Form")
                .Range("F3") = r.Offset(0, 1)
            End With
        End If
    Next r
    Application.CutCopyMode = False
    MsgBox "Get data has finished."
End Sub

[bank9597]

ได้แล้วครับอาจารย์ ขอบคุณครับ อิอิอิ (ดีใจมากๆ)

[bank9597]

อาจารย์ครับ จากสูตรที่อาจารย์ให้มาถ้าเป็นการดึงข้อมูลไปวางเซลล์ที่มีขนาดไม่เท่ากัน เราจะแก้อย่างไรบ้างครับ เพราะฟอร์มที่เราสร้างขึ้น มันจะมีการผสานเซลล์อยู่อ่าครับ

[snasui]

สูตรไหนครับ

ช่วยแนบไฟล์ชี้ให้เห็นด้วยครับว่าปัญหาคือะไร ต้องการคำตอบเป็นอย่างไร จะได้เข้าใจตรงกันครับ

[bank9597]

คือผมเอาสูตร

Code: Select all

Sub PullToEdit()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Set rFind = Sheets("Form").Range("F4")
    If Sheets("Form").Range("F4") = "" Then Exit Sub
    With Sheets("Data")
        Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("äÁèÁÕàÅ¢ QO ¹Õé")
            Exit Sub
        End If
    End With
    For Each r In rDataAll
        If r = rFind Then
            Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
                .Offset(1, 0)
            r.Offset(0, 2).Resize(1, 3).Copy
            rTarget.PasteSpecial xlPasteValues
            With Sheets("Form")
                .Range("F3") = r.Offset(0, 1)
            End With
        End If
    Next r
    Application.CutCopyMode = False
    MsgBox "Get data has finished."
End Sub

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

[snasui]

ที่โพสต์มานั้นไม่ใช่สูตรแต่เป็น Code VBA ครับ

[bank9597]

ติดปากครับ อิอิ

เดี๋ยวเที่ยงผมต้องไปหาดูหนังสืออีกครับ (วันก่อนได้แต่ Access มา)วันนี้ต้องได้ Excel VBA อิอิ


ที่อาจารย์เขียนโค๊ดมาให้ ผมเข้าใจน่ะครับ เพียงแต่ยังใช้ไม่ค่อยถูก ต้องฝึกไปเรื่อยๆ

[bank9597]

อาจารย์ครับ ผมยังจับทางการใช้โค๊ดไม่ถูกเลยครับ ผมนำเอาไปปรับใช้ แต่ก็ยังไม่ได้เหมือนที่อาจารย์ทำมาให้ดูเป็นตัวอย่างเลย ครับ ผมเลยส่งไฟล์มาให้อาจารย์ดู (เหลืออีกไม่มากก็น่าจะใช้ได้แล้วครับ แต่ต้องปรับอีกครับ)
อธิบาย
ในชีท Wellcome จะมีปุ่มที่ชื่อ "ทำใบสั่งซื้ออ้างใบสอบราคา" โดยปุ่มนี้จะเป็นปุ่มที่เรียกฟอร์มมาแสดง และภายในฟอร์มก็จะมีช่องให้ใส่เลขรหัส QO ครับ พอคลิกปุ่มแล้วมันจะดึงข้อมูลจากชีท "DATA" ไปยังชีท "PurchaseOrder" ครับ
ฟอร์มที่ใช้งานชื่อ Userform6 ครับ

ปัญหาที่เจอคือ
ในชีท "PurchaseOrder" มีการผสานเซลล์ไว้ ทำให้ดึงข้อมูลไปลงไม่ได้ ผมเลยยกเลิกการผสานเซลล์แล้วดึงข้อมูลดูครับ ปรากฏว่าดึงข้อมูลได้ครับ แต่แสดงไม่ถูกช่องที่กำหนดไว้

ผมได้กรอกข้อมูลไว้เป็นตัวอย่างแล้วครับ Password 240130

[snasui]

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

Code: Select all

Private Sub CommandButton1_Click()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Dim irow As Long
    Dim ws As Worksheet
    Sheets("PurchaseOrder").Unprotect Password:="240130" '<==UnProtect
    Set ws = Worksheets("PurchaseOrder")
    'find first empty row in database
    irow = ws.Cells("8") _
        .End(xlUp).Range("H10").Row
    'Check for Id
    If Trim(Me.TextBox1.Value) = "" Then
        Me.TextBox1.SetFocus
        MsgBox "เลือกหน่วยงาน"
        Exit Sub
    End If
    'copy the data to the database
    ws.Cells(irow, 8).Value = Me.TextBox1.Value
    
    'Clear the data
    Me.TextBox1.Value = ""
    Me.TextBox1.SetFocus
    
    Set rFind = Sheets("PurchaseOrder").Range("H10")
        If Sheets("PurchaseOrder").Range("H10") = "" Then Exit Sub
        With Sheets("Data")
            Set rDataAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
            If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
                MsgBox ("ไม่มีเลขที่ QO นี้")
                Exit Sub
            End If
        End With
        For Each r In rDataAll
            If r = rFind Then
                Set rTarget = Sheets("PurchaseOrder").Range("B" & Rows.Count).End(xlUp) _
                    .Offset(1, 0)
                rTarget = r.Offset(0, 1)
                rTarget.Offset(0, 1) = r.Offset(0, 2)
                rTarget.Offset(0, 5) = r.Offset(0, 3)
                rTarget.Offset(0, 6) = r.Offset(0, 4)
                With Sheets("PurchaseOrder")
                    .Range("I13") = r ': .Range("C7") = r.Offset(0, 1)
                End With
            End If
        Next r
        Application.CutCopyMode = False
        MsgBox "Get data has finished."
        Sheets("PurchaseOrder").Select
    If Sheets("PurchaseOrder").Select Then
    UserForm6.Hide
    End If
    Sheets("PurchaseOrder").Protect Password:="240130" '<== Protect Again
End Sub

[bank9597]

ได้แล้วครับอาจารย์ เหลือช่องเดียวที่ยังวางไม่ถูก คือช่อง I13 ครับ จะเป็นชื่อหน่วยงานครับ

ถ้ายังไง ผมจะทำต่อครับ ถ้าอาจารย์จะพักผ่อน

[snasui]

อันนี้ลองปรับเองครับ ซึ่งคิดว่าเป็นเรื่องง่าย ๆ ครับ

[bank9597]

ได้เลยครับ ยังผมต้องขอบคุณอาจารย์ครับ ส่งเกือบถึงฝั่งแล้ว อิอิ

[bank9597]

ต้องยอมรับว่าอาจารย์สับขาหลอกผมไว้เยอะ ทำเอาผมมึนกันไปหลายตลบเลยทีเดียวครับ

รายงานผลครับ ก็ประสบความสำเร็จตามที่อาจารย์คาดหวัง และก็เข้าใจโค๊ดที่อาจารย์มาเข้าใจเยอะกว่าเดิมมากแล้วครับ

เหลืออย่างเดียวครับ คือเราจะทำอย่างไรให้ดึงข้อมูลครั้งที่ 2 มาทับข้อมูลเดิมที่เคยดึงมาครั้งที่ 1

คอยลองทำแบบวิธี http://snasui.blogspot.com/2011/06/vba_26.html
แต่มันจะทำให้ค่า Validation หายไปครับ ผมยังพยายามหาวิธแก้อยู่ครับ แต่ก็ยังไม่ได้