ต้องการค้นหาข้อมูลด้วย Combobox และให้ข้อมูลมาเเสดงใน Listbox

[thinatda]

ต้องการค้นหาข้อมูลด้วย Combobox โดยเลือกจาก รายการสารมาตรฐาน และ Lot no.ให้ข้อมูลมาเเสดงใน Listbox ค่ะ
ตอนนี้กด F5 ติด error Subscript out of range

Code: Select all

Dim dict, key
Dim lastrow As Long
lastrow = Application.WorksheetFunction.CountA(Range("B:B"))
With Sheets("Sheet2").Range("B2:B" & lastrow)
dict = .Value
End With
With CreateObject("scripting.dictionary")
comparemode = 1 'vbTextCompare – case of words doesn't matter: apple is the same as Apple
For Each key In dict
    If Not .exists(key) Then .Add key, Nothing
Next
If .Count Then Me.cbRegion.List = Application.Transpose(.keys)
End With
With Sheets(Sheet2).Range("H2:H" & lastrow)
dict = .Value
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each key In dict
If Not .exists(key) Then .Add key, Nothing
Next
If .Count Then Me.cbItem.List = Application.Transpose(.keys)
End With


End Sub
Private Sub FilterData()
Dim Region As String
Dim Item_Type As String

Dim myDB As Range

With Me
If .cbRegion.ListIndex < 0 Or .cbItem.ListIndex < 0 Then Exit Sub

Region = .cbRegion.Value
Item_Type = .cbItem.Value
End With

With ActiveWorkbook.Sheets("Sheet2")
Set myDB = .Range("B1:T1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
End With

With myDB
.AutoFilter 'remove filters
.AutoFilter Field:=1, Criteria1:=Region ' filter data
.SpecialCells(xlCellTypeVisible).AutoFilter Field:=3, Criteria1:=Item_Type 'filter data again
Call UpdateListBox(Me.MyListbox, myDB, 1)
.AutoFilter
End With
End Sub

Sub UpdateListBox(MyListbox As MSForms.ListBox, myDB As Range, columnToList As Long)
Dim cell As Range, dataValues As Range

If myDB.SpecialCells(xlCellTypeVisible).Count > myDB.Columns.Count Then
    Set dataValues = myDB.Resize(myDB.Rows.Count + 1)
   MyListbox.Clear ' we clear the listbox before adding new elements
    For Each cell In dataValues.Columns(columnToList).SpecialCells(xlCellTypeVisible)
        With Me.MyListbox
        .AddItem cell.Value
        .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
        .List(.ListCount - 1, 2) = cell.Offset(0, 2).Value
        .List(.ListCount - 1, 3) = cell.Offset(0, 3).Value
         .List(.ListCount - 1, 4) = cell.Offset(0, 4).Value
        .List(.ListCount - 1, 5) = cell.Offset(0, 5).Value
        .List(.ListCount - 1, 6) = cell.Offset(0, 6).Value
         .List(.ListCount - 1, 7) = cell.Offset(0, 7).Value
        .List(.ListCount - 1, 8) = cell.Offset(0, 8).Value
        .List(.ListCount - 1, 9) = cell.Offset(0, 9).Value
         .List(.ListCount - 1, 10) = cell.Offset(0, 10).Value
        .List(.ListCount - 1, 11) = cell.Offset(0, 11).Value
        .List(.ListCount - 1, 12) = cell.Offset(0, 12).Value
         .List(.ListCount - 1, 13) = cell.Offset(0, 13).Value
        .List(.ListCount - 1, 14) = cell.Offset(0, 14).Value
        .List(.ListCount - 1, 15) = cell.Offset(0, 15).Value
         .List(.ListCount - 1, 16) = cell.Offset(0, 16).Value
        .List(.ListCount - 1, 17) = cell.Offset(0, 17).Value
      
        End With

    Next cell
Else
    MyListbox.Clear ' if no match then clear listbox
End If
MyListbox.SetFocus
End Sub

[logic]

กด f8 ไปทีละขั้น ๆ ดูก่อนว่าติดบรรทัดไหนครับ

[thinatda]

กด f8 ไปทีละขั้น ๆ ดูก่อนว่าติดบรรทัดไหนครับ

บรรทัดนี้ค่ะ
With Sheets("Sheet2").Range("B2:B" & lastrow)

[logic]

ไฟล์นั้นไม่มีชีตที่ชื่อ Sheet2 ก็เลยเออเรอร์ครับ

[thinatda]

ไฟล์นั้นไม่มีชีตที่ชื่อ Sheet2 ก็เลยเออเรอร์ครับ

ตอนนี้ไม่ error แล้วค่ะ แต่ข้อมูลไม่แสดงใน Listbox ค่ะ

[logic]

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

[thinatda]

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

ติดบรรทัดนี้ค่ะ .List(.ListCount - 1, 10) = cell.Offset(0, 10).Value

Code: Select all

Sub UpdateListBox(MyListbox As MSForms.ListBox, myDB As Range, columnToList As Long)
Dim cell As Range, dataValues As Range
If myDB.SpecialCells(xlCellTypeVisible).Count > myDB.Columns.Count Then
    Set dataValues = myDB.Resize(myDB.Rows.Count + 1)
   MyListbox.Clear ' we clear the listbox before adding new elements
    For Each cell In dataValues.Columns(columnToList).SpecialCells(xlCellTypeVisible)
        With Me.MyListbox
        .AddItem cell.Value
        .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
        .List(.ListCount - 1, 2) = cell.Offset(0, 2).Value
        .List(.ListCount - 1, 3) = cell.Offset(0, 3).Value
        .List(.ListCount - 1, 4) = cell.Offset(0, 4).Value
        .List(.ListCount - 1, 5) = cell.Offset(0, 5).Value
        .List(.ListCount - 1, 6) = cell.Offset(0, 6).Value
        .List(.ListCount - 1, 7) = cell.Offset(0, 7).Value
        .List(.ListCount - 1, 8) = cell.Offset(0, 8).Value
         .List(.ListCount - 1, 9) = cell.Offset(0, 9).Value
        .List(.ListCount - 1, 10) = cell.Offset(0, 10).Value
        .List(.ListCount - 1, 11) = cell.Offset(0, 11).Value
        .List(.ListCount - 1, 12) = cell.Offset(0, 12).Value
        .List(.ListCount - 1, 13) = cell.Offset(0, 13).Value
        .List(.ListCount - 1, 14) = cell.Offset(0, 14).Value
        .List(.ListCount - 1, 15) = cell.Offset(0, 15).Value
        .List(.ListCount - 1, 16) = cell.Offset(0, 16).Value
        .List(.ListCount - 1, 17) = cell.Offset(0, 17).Value
        End With

    Next cell
Else
    MyListbox.Clear ' if no match then clear listbox
End If
MyListbox.SetFocus
End Sub

[thinatda]

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

ตอนนี้แก้ได้แล้วนะค่ะ ขอบคุณค่ะ