ดึงข้อมูลไม่ได้

[tutape]

ผมได้ลองปรับใช้ VBA เกี่ยวกับการดึงข้อมูลจากฐานข้อมูล แต่ปรากฎว่าลองทำแล้ว ดึงข้อมูลมาไม่ได้
รบกวนช่วยแนะนำด้วยครับ
โค้ดที่ใช้ในหน้าสำหรับแสดงข้อมูล (ชีท find_deberk)

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$d$1" And Target <> "" Then
        showemp
    ElseIf Target.Address = "$d$1" And Target = "" Then
        MsgBox "Please select data."
    End If
End Sub

ส่วนโค้ดที่ใส่ใน module คือ

Code: Select all

Option Explicit
Option Base 1
Sub showemp()
    Dim a() As Variant, ing As Long
    Dim r As Range, rall As Range
    Dim rt As Range, rl As Long
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    rl = Rows.Count
    With Worksheets("dbberk")
        Set rall = .Range("F4", .Range("F" & rl).End(xlUp))
    End With
    For Each r In rall
        If r = Worksheets("find_deberk").Range("d1") Then
            ing = ing + 1
            ReDim Preserve a(5, ing)
            a(1, ing) = ing
            a(2, ing) = r.Offset(0, -5)
            a(3, ing) = r.Offset(0, -4)
            a(4, ing) = r.Offset(0, -3)
            a(5, ing) = r.Offset(0, -2)
        End If
    Next r
    If ing > 0 Then
        With Worksheets("find_deberk")
            Set rt = .Range("c4", .Range("f" & ing - 1 + 5))
            .Range("c4", .Range("c" & rl).End(xlUp).Offset(0, 4)).ClearContents
            .Range("c4:f4").Copy
            rt.PasteSpecial xlPasteFormats
            rt = Application.Transpose(a)
      '      .Range("B5", .Range("B" & rl).End(xlUp)).NumberFormat = "000000"
            .Range(.Range("c4").End(xlDown).Offset(1, 0), .Range("f" & rl)).Clear
            .Range("d1").Activate
        End With
    Else
        MsgBox "Data Not Found."
    End If
    Application.EnableEvents = True
     Application.ScreenUpdating = True
End Sub

[snasui]

รบกวนช่วยแนะนำด้วยคับ

คำว่า "คับ" ที่ใช้แทน "ครับ" ผิดกฎตามด้านบน ช่วยแก้ด้วยครับ

สำหรับที่ถามมา ให้ปรับ If Target.Address = "$d$1" And Target <> "" Then เป็น If Target.Address = "$D$1" And Target <> "" Then ครับ

[tutape]

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

[snasui]

ช่วยแสดงตัวอย่างคำตอบที่ต้องการมาด้วย และควรจะปรับ Code มาเอง แจ้งมาด้วยว่า Code บรรทัดใดทำงานไม่ถูกต้อง

การที่จะใช้ Code นั้นได้ย่อมต้องเข้าใจ Array ดีพอควร หากไม่เข้าใจไม่ควรใช้ ในต้นแหล่งผมก็บอกทางเลือกไว้แล้วว่าให้บันทึก Macro โดยใช้ Advanced Filter แทนครับ

ตัวอย่างการใช้ Code แบบอื่นที่น่าจะเข้าใจได้สะดวกกว่า viewtopic.php?f=3&t=6719

[tutape]

ถ้าหากใช้ VBA ไม่ได้ จะใช้แนวทางไหนได้บ้างครับ

[snasui]

ใช้ Filter หรือ Advanced Filer แทนครับ