การค้นหาข้อมูลแบบ 3 ชั้น

[yodpao.b]

ผมทำได้แค่การค้นหา 2 ชั้น จึงรบกวนอาจาร์ยช่วยทำต่อให้ด้วยครับ
ขอบคุณครับ

[snasui]

ผมลองปรับ Code มาเป็นตัวอย่างตามด้านล่าง ลองทดสอบใช้งานดูครับ

Code: Select all

Private Sub CbB2_Change()
CbB3.Clear
'MyCbB2 = CbB2.Text
Range("C7").Select
'    Do While True
'        If MyCbB2 = ActiveCell.Value Then
'             Exit Do
'         End If
'         ActiveCell.Offset(1, 0).Select
'    Loop
    Do While Selection <> ""
        If CbB2 = ActiveCell And ActiveCell.Offset(0, 1) <> ActiveCell.Offset(-1, 1) Then
            CbB3.AddItem ActiveCell.Offset(0, 1).Value
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Private Sub UserForm_Initialize()
ActiveWorkbook.Sheets("HistoryDurable").Activate
'Range("B7").Select
'Selection.End(xlDown).Select  'เลือกจุดสุดท้าย
'TB1.Value = ActiveCell.Offset(0, 0).Value + 1  'เลือกจุดนั้นแล้วบวก
TB1 = Range("B7").End(xlDown) + 1
Range("C7").Select
'MyCbB2Initial = ActiveCell.Value
MyCbB2 = ActiveCell.Value
CbB2.AddItem MyCbB2
ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell.Value)
        If MyCbB2 <> ActiveCell.Value Then
            MyCbB2 = ActiveCell.Value
            CbB2.AddItem MyCbB2
        End If
            ActiveCell.Offset(1, 0).Select
    Loop
End Sub

[yodpao.b]

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

[snasui]

ติดตรงไหนช่วยแจ้งด้วยครับ เพราะตอนผมทดสอบไม่เกิด Error ครับ จะได้พิจารณาเฉพาะจุดและจะได้ลดเวลาในการลองผิดลองถูก หากได้พยายามปรับแก้แล้วช่วยแจ้งมาด้วยครับว่าได้ลองแก้เป็นอย่างไรไปบ้างแล้ว

[yodpao.b]

ที่อาจาร์ยได้ทำให้เป็นการค้นหา 2 ชั้น ใช้ได้ดีครับ แต่ผมทำเพิ่มเป็น 3 ชั้นจึง error ช่วยทดสอบให้ทีครับ

[snasui]

จากที่ทดสอบสามารถ Run ได้ครับ ไม่ทราบว่า Code ใดมีปัญหาครับ

[yodpao.b]

เมื่อเลือกครบทั้ง 4 บรรทัดแล้ว ให้เลือกชนิดพัสดุใหม่อีกครั้งหนึ่งผลที่ได้คือเครื่องจะหาไม่ได้และจะ Error อาจารย์ลองเปิดไฟล์ใหม่ดูนะครับ
คำถาม
เมื่อคลีกชนิดพัสดุรอบ 2 จะ error สาเหตุมาจากCbB3.Clear , CbB4.Clear ไม่ใส่ก็ไม่ได้

" อาจารย์ลองเปิดไฟล์ใหม่ดูนะครับ "

[yodpao.b]

code ที่เข้าใจว่าไม่ถูกต้องสงสัยว่าน่าจะเป็น CbB4.ClearPrivate Sub CbB3_Change()
ถ้าไม่ใช้ก็ไม่ได้มันจะไม่เครียร์ข้อมูลเก่า
CbB4.Clear
Range("D7").Select
Do While Selection <> ""
If CbB3 = ActiveCell And ActiveCell.Offset(0, 1) <> ActiveCell.Offset(-1, 1) Then
CbB4.AddItem ActiveCell.Offset(0, 1).Value
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Private Sub CbB4_Change()
MyCbB4 = CbB4.Text
CbB5.Clear
Range("E7").Select
Do While True
If MyCbB4 = ActiveCell.Value Then
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
Do While MyCbB4 = ActiveCell.Value
CbB5.AddItem ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub

[snasui]

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

Code: Select all

Private Sub CbB4_Change()
    MyCbB4 = CbB4.Text
    CbB5.Clear
    Range("E7").Select
'        Do While True
'            If MyCbB4 = ActiveCell.Value Then
'                  Exit Do
'            End If
'            ActiveCell.Offset(1, 0).Select
'         Loop
'         Do While MyCbB4 = ActiveCell.Value
'            CbB5.AddItem ActiveCell.Offset(0, 1).Value
'            ActiveCell.Offset(1, 0).Select
'        Loop
    Do While Selection <> ""
        If CbB4 = ActiveCell And ActiveCell.Offset(0, 1) <> ActiveCell.Offset(-1, 1) Then
            CbB5.AddItem ActiveCell.Offset(0, 1).Value
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

[yodpao.b]

สุดยอดเลยครับ ผมต้องปรับของเก่าที่เคยทำไว้มาใช้แบบนี้แล้ว เจ๋งสุดสุดเลยครับ