อยากให้แสดงข้อมูลของแต่ละแผนกจาก DATABASE ครับ

[sweetielime00]

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

[logic]

ต้องเขียนโค้ดกันมาเองก่อน ดูกติกาด้านบนเพจนี้ประกอบครับ ☝

[sweetielime00]

อันนี้เป็นCode ในหน้า REPORTหน่วยงานครับ

Code: Select all

Private Sub ComboBox1_Change()

Me.ComboBox1.AddItem "ธุรการสารบรรณ"
Me.ComboBox1.AddItem "การเจ้าหน้าที่"
Me.ComboBox1.AddItem "การเงินและบัญชี"
Me.ComboBox1.AddItem "พัสดุ"
Me.ComboBox1.AddItem "บริการการศึกาษาระดับปริญญาตรี"
Me.ComboBox1.AddItem "บัณฑิตศึกษา"
Me.ComboBox1.AddItem "พัฒนาคุรภาพนักศึกษา"
Me.ComboBox1.AddItem "ห้องสร้างสรรค์เพื่อการเรียนรู้"
Me.ComboBox1.AddItem "ศูนย์การเรียนรู้ร่วมการทำงาน"
Me.ComboBox1.AddItem "ประชาสัมพันธ์"
Me.ComboBox1.AddItem "วิเทศสัมพันธ์"
Me.ComboBox1.AddItem "สำนักวิชา"

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$C$20" And Target <> "" Then
   Show Emp
ElseIf Target.Address = "$C$20" And Target = "" Then
MsgBox "Please Select Data."

End If
End Sub

[sweetielime00]

หน้านี้เป็นCode ใน Module ของผมครับ

Code: Select all

Option Explicit
Option Base 1

Sub ShowEmp()
    Dim a() As Variant, lng 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("Sheet1")
        Set rAll = .Range("C20", .Range("C" & rl).End(xlUp))
    End With
    For Each r In rAll
        If r = Worksheets("REPORTหน่วยงาน").Range("C20") Then
            lng = lng + 1
            ReDim Preserve a(11, lng)
            a(1, lng) = lng
            a(2, lng) = r.Offset(0, -11)
            a(3, lng) = r.Offset(0, -10)
            a(4, lng) = r.Offset(0, -9)
            a(5, lng) = r.Offset(0, -8)
            a(6, lng) = r.Offset(0, -7)
            a(7, lng) = r.Offset(0, -6)
            a(8, lng) = r.Offset(0, -5)
            a(9, lng) = r.Offset(0, -4)
            a(10, lng) = r.Offset(0, -3)
            a(11, lng) = r.Offset(0, -2)
            
        End If
    Next r
    If lng > 0 Then
        With Worksheets("REPORT หน่วยงาน")
            Set rt = .Range("A24", .Range("C" & lng - 1 + 5))
            .Range("A24", .Range("A" & rl).End(xlUp).Offset(0, 4)).ClearContents
            .Range("A24:AR24").Copy
            rt.PasteSpecial xlPasteFormats
            rt = Application.Transpose(a)
            .Range("A2", .Range("A" & rl).End(xlUp)).NumberFormat = "0000"
            .Range(.Range("A22").End(xlDown).Offset(1, 0), .Range("AN" & rl)).Clear
            .Range("C20").Activate
        End With
    Else
        MsgBox "Data not found."
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

[snasui]

ที่เขียนมาเองนั้นอยู่ใน Module ใด ติดขัดบรรทัดไหน กรุณาทำตามกฎการใช้บอร์ดข้อ 5 ด้านบน ที่สำคัญ กรุณาแนบไฟล์ Excel มาด้วยจะได้ช่วยกันทดสอบให้ได้ครับ

[sweetielime00]

ติดอยู่ใน Module 2 ครับ บรรทัด

If r = Worksheets("REPORTCหน่วยงาน").Range("C20") Then

Code: Select all

Option Explicit
Option Base 1

Sub ShowEmp()
    Dim a() As Variant, lng 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("Sheet1")
        Set rAll = .Range("C20", .Range("C" & rl).End(xlUp))
    End With
    For Each r In rAll
        If r = Worksheets("REPORTหน่วยงาน").Range("C20") Then <<<<<<<<<<<<<<<<<<<<< error ตรงบรรทัดนี้ใน Module 2 ครับขึ้นDebug  "Run-time error '13': Type mismatch" 
                   lng = lng + 1
            ReDim Preserve a(11, lng)
            a(1, lng) = lng
            a(2, lng) = r.Offset(0, -11)
            a(3, lng) = r.Offset(0, -10)
            a(4, lng) = r.Offset(0, -9)
            a(5, lng) = r.Offset(0, -8)
            a(6, lng) = r.Offset(0, -7)
            a(7, lng) = r.Offset(0, -6)
            a(8, lng) = r.Offset(0, -5)
            a(9, lng) = r.Offset(0, -4)
            a(10, lng) = r.Offset(0, -3)
            a(11, lng) = r.Offset(0, -2)
            
        End If
    Next r
    If lng > 0 Then
        With Worksheets("REPORT หน่วยงาน")
            Set rt = .Range("A24", .Range("C" & lng - 1 + 5))
            .Range("A24", .Range("A" & rl).End(xlUp).Offset(0, 4)).ClearContents
            .Range("A24:AR24").Copy
            rt.PasteSpecial xlPasteFormats
            rt = Application.Transpose(a)
            .Range("A2", .Range("A" & rl).End(xlUp)).NumberFormat = "0000"
            .Range(.Range("A22").End(xlDown).Offset(1, 0), .Range("AN" & rl)).Clear
            .Range("C20").Activate
        End With
    Else
        MsgBox "Data not found."
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

[snasui]

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

กรุณาทำตามที่ผมระบายสีข้อความไว้ครับ

[sweetielime00]

PlanTraining.xlsm

[snasui]

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

[sweetielime00]

อันนี้ไฟล์ Excel ครับ

PlanTraining_test.xlsm

อยากให้ในหน้า "REPORTหน่วยงาน" กดค้นหาชื่อจาก Listbox ในเซลล์ที่ "C17" แล้วดึงข้อมูลจาก "Sheet1" มาครับ แต่มันติด Error ในModule 2 "Run Time Error:13"

- ตัวอย่างขั้นตอนการทำงาน คือ อยากให้คลิกที่ปุ่ม List box เลือกหน่วยงาน "เจ้าหน้าที่" แล้วให้มันโชว์ข้อมูลหน่วยงาน"เจ้าหน้าที่" ทั้งหมดที่อยู่ในหน่วยงานครับ จากหน้า Sheet1

[snasui]

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

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

ไม่ควรดักการเปลี่ยนแปลงใน ComboBox เพื่อ Add Item เข้าไป เพราะการทำเช่นนั้นจะทำให้มีรายการเพิ่มเข้าไปทุกครั้งที่ ComboBox มีการเปลี่ยนแปลง แต่ให้ Add Item ด้วยเหตุการณ์ใด ๆ แทน

ตัวอย่างการ Loop เพื่อตรวจสอบกับค่าที่เลือกใน ComboBox แล้วนำค่ามาแสดงที่ชีต REPORTหน่วยงาน ลองนำไปปรับปรุงมาเองก่อนที่จะถามกันต่อไป ทุกคำถามจะต้องมีการปรับปรุงมาเองก่อนเสมอครับ

Code: Select all

Sub searchdata2() 
    Dim rall As Range, r As Range
    Dim v As String
    v = ActiveSheet.Shapes("ComboBox1").OLEFormat.Object.Object.Text
    With Worksheets("Sheet1")
        Set rall = .Range("d2", .Range("d" & .Rows.count).End(xlUp))
    End With
    For Each r In rall
        If r.Value = v Then
            With Worksheets("REPORTหน่วยงาน")
                With .Range("a" & .Rows.count).End(xlUp)
                    .Offset(1, 0).Value = r.Offset(0, -3).Value
                    .Offset(1, 1).Value = r.Value
                    .Offset(1, 2).Value = r.Offset(0, 2).Value
                End With
            End With
        End If
    Next r
End Sub
[code]