ขออนุญาตสอบถามเรื่องปัญหา code การค้นหาและปฏิทิน

[9KiTTi]

ขออนุญาตอ้างถึง

Code: Select all

https://snasui.com/viewtopic.php?f=3&t=18301

ของสมาชิกครับ
ผมได้นำมาปรับเพิ่มเติมในฟอร์มการค้นหา แต่ติดปัญหาไม่สามารถใช้งานได้

Code: Select all

Option Explicit
Dim FormEvents As Boolean
Private Sub ClearForm(Except As String)
    Select Case Except
    
        Case "ReceiveNO"
            FormEvents = False
            BookNO.value = ""
            DateIN.value = ""
            From.value = ""
            Too.value = ""
            Detail.value = ""
            Results.Clear
            FormEvents = True

        Case "BookNO"
            FormEvents = False
            ReceiveNO.value = ""
            DateIN.value = ""
            From.value = ""
            Too.value = ""
            Detail.value = ""
            Results.Clear
            FormEvents = True

        Case "DateIN"
            FormEvents = False
            ReceiveNO.value = ""
            BookNO.value = ""
            From.value = ""
            Too.value = ""
            Detail.value = ""
            Results.Clear
            FormEvents = True

        Case "From"
            FormEvents = False
            ReceiveNO.value = ""
            BookNO.value = ""
            DateIN.value = ""
            Too.value = ""
            Detail.value = ""
            Results.Clear
            FormEvents = True
        
        Case "Too"
            FormEvents = False
            ReceiveNO.value = ""
            BookNO.value = ""
            DateIN.value = ""
            From.value = ""
            Detail.value = ""
            Results.Clear
            FormEvents = True
            
        Case "Detail"
            FormEvents = False
            ReceiveNO.value = ""
            BookNO.value = ""
            DateIN.value = ""
            From.value = ""
            Too.value = ""
            Results.Clear
            FormEvents = True
            
        Case Else
            FormEvents = False
            ReceiveNO.value = ""
            BookNO.value = ""
            DateIN.value = ""
            From.value = ""
            Too.value = ""
            Detail.value = ""
            Results.Clear
            FormEvents = True
            
        End Select

End Sub

Private Sub BasicCalendar_Click()
    dateVariable = CalendarForm.GetDate
    If dateVariable <> 0 Then SearchForm.DateIN.Text = Format(dateVariable, "d mmm yyyy")
End Sub

Private Sub ClearBtn_Click()

    ClearForm ("")
    
End Sub

Private Sub CloseBtn_Click()
    
    Me.Hide

End Sub

Private Sub ReceiveNO_Change()
    
    If FormEvents Then ClearForm ("ReceiveNO")
    
End Sub

Private Sub BookNO_Change()
    
    If FormEvents Then ClearForm ("BookNO")
    
End Sub

Private Sub DateIN_Change()
    
    If FormEvents Then ClearForm ("DateIN")
    
End Sub

Private Sub From_Change()
    
    If FormEvents Then ClearForm ("From")
    
End Sub

Private Sub Too_Change()
    
    If FormEvents Then ClearForm ("Too")
    
End Sub

Private Sub Detail_Change()
    
    If FormEvents Then ClearForm ("Detail")
    
End Sub
Private Sub SearchBtn_Click()

    Dim SearchTerm As String
    Dim SearchColumn As String
    Dim RecordRange As Range
    Dim FirstAddress As String
    Dim FirstCell As Range
    Dim RowCount As Integer
    
    If ReceiveNO.value = "" And BookNO.value = "" And DateIN.value = "" And From.value = "" And Too.value = "" And Detail.value = "" Then
    
        MsgBox "No search term specified", vbCritical + vbOKOnly
        Exit Sub
    
    End If
  
    If ReceiveNO.value <> "" Then
    
        SearchTerm = ReceiveNO.value
        SearchColumn = "เลขทะเบียนรับ"
        
    End If
    
    If BookNO.value <> "" Then
    
        SearchTerm = BookNO.value
        SearchColumn = "ที่"
        
    End If

    If DateIN.value <> "" Then
    
        SearchTerm = DateIN.value
        SearchColumn = "ลงวันที่"
        
    End If

    If From.value <> "" Then
    
        SearchTerm = From.value
        SearchColumn = "จาก"
        
    End If
    
    If Too.value <> "" Then
    
        SearchTerm = Too.value
        SearchColumn = "ถึง"
        
    End If
    
    If Detail.value <> "" Then
    
        SearchTerm = Detail.value
        SearchColumn = "เรื่อง"
    End If 
    Results.Clear
        With Range("data[" & SearchColumn & "]")
            Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
            If Not RecordRange Is Nothing Then
                FirstAddress = RecordRange.Address
                RowCount = 0
                Do
                    Set FirstCell = Range("B" & RecordRange.Row)
                    Results.AddItem
                    Results.List(RowCount, 0) = FirstCell(1, 1)
                    Results.List(RowCount, 1) = FirstCell(1, 2)
                    Results.List(RowCount, 2) = FirstCell(1, 3)
                    Results.List(RowCount, 3) = FirstCell(1, 4)
                    Results.List(RowCount, 4) = FirstCell(1, 5)
                    Results.List(RowCount, 5) = FirstCell(1, 6)
                    RowCount = RowCount + 1
                    Set RecordRange = .FindNext(RecordRange)
                    If RecordRange Is Nothing Then
                        Exit Sub
                    End If
                Loop While RecordRange.Address <> FirstAddress
            Else         
                Results.AddItem
                Results.List(RowCount, 0) = "ไม่พบข้อมูลที่ต้องการ!!!"        
            End If
        End With
End Sub

Private Sub UserForm_Initialize()

    FormEvents = True

End Sub

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

Code: Select all

Private Sub BasicCalendar_Click()
    dateVariable = CalendarForm.GetDate
    If dateVariable <> 0 Then SearchForm.DateIN.Text = Format(dateVariable, "d mmm yyyy")
End Sub

ขอบพระคุณครับ

[9KiTTi]

ตอนนี้ผมสามารถแก้ไขเรื่องปฏิทินได้แล้วครับ แต่พอกด seaarch แล้ว ไม่สามารถค้นหาข้อมูลได้ครับ รบกวนแนะนำผมด้วยครับ

ขอบพระคุณครับ

[snasui]

กรุณาแนบไฟล์ล่าสุดมาด้วยจะได้ตอบต่อไปจากนั้นครับ

[9KiTTi]

ไฟล์ล่าสุดครับ

[snasui]

ตอนนี้ผมสามารถแก้ไขเรื่องปฏิทินได้แล้วครับ แต่พอกด seaarch แล้ว ไม่สามารถค้นหาข้อมูลได้ครับ รบกวนแนะนำผมด้วยครับ

ขอบพระคุณครับ

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

[9KiTTi]

ปุ่ม search จะอยู่ในหน้าหนังสือทะเบียนรับ อยู่ใน frame รายละเอียดหนังสือ เลือกหมวดรายการค้นหาจาก "ค้นหาจาก" โดยใส่คำในช่อง "สิ่งที่ต้องการค้นหา" แล้วกด Search ครับ ถ้าจากพบข้อมูลในแสดงรายละเอียดใน listbox ข้างล่างครับ แต่หลังจากกดแล้วขึ้น ขึ้น rum-time error 1004 ครับ
vba ที่มใช้กับปุ่ม search ตามนี้ครับ

Code: Select all

Sub SearchData()

    Application.ScreenUpdating = False
    
    Dim shDatabase As Worksheet ' Database sheet
    Dim shSearchData As Worksheet 'SearchData sheet
    
    Dim iColumn As Integer 'To hold the selected column number in Database sheet
    Dim iDatabaseRow As Long 'To store the last non-blank row number available in Database sheet
    Dim iSearchRow As Long 'To hold the last non-blank row number available in SearachData sheet
    
    Dim sColumn As String 'To store the column selection
    Dim sValue As String 'To hold the search text value
    
    
    Set shDatabase = ThisWorkbook.Sheets("Database")
    Set shSearchData = ThisWorkbook.Sheets("SearchData")
    
    
    iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).Row
    
    
    sColumn = frmForm.cmbSearchColumn.value
    
    sValue = frmForm.txtSearch.value
    
    
    iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:K1"), 0)
    
    'Remove filter from Database worksheet
    
    If shDatabase.FilterMode = True Then
    
       shDatabase.AutoFilterMode = False
    
    End If

    'Apply filter on Database worksheet
    
    If frmForm.cmbSearchColumn.value = "เลขทะเบียนรับ" Then
    
        shDatabase.Range("A1:K" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
    
    Else
    
        shDatabase.Range("A1:K" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
    
    End If
    
    If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then
    
        'Code to remove the previous data from SearchData worksheet
        
        shSearchData.Cells.Clear
        
        shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")
        
        Application.CutCopyMode = False
        
        iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).Row
        
        
        frmForm.lstDatabase.ColumnCount = 12
        
        frmForm.lstDatabase.ColumnWidths = "40,70,75,75,75,80,70,70,70,350,70,70"
        
        If iSearchRow > 1 Then
        
            frmForm.lstDatabase.RowSource = "SearchData!A2:K" & iSearchRow
            
            MsgBox "ไม่พบข้อมูลที่ค้นหา"
        
        End If
        
        
    Else
    
       MsgBox "No record found."
    
    End If

    shDatabase.AutoFilterMode = False
    Application.ScreenUpdating = True


End Sub

ขอวิธีแก้ไขด้วยครับ ขอบพระคุณครับ

[snasui]

กำหนดของเขต Table ใหม่ตามภาพครับ

ResizesTable.png (59.77 KiB) Viewed 129 times

[9KiTTi]

กำหนดของเขต Table ใหม่ตามภาพครับ

ResizesTable.png

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

[snasui]

ควร Debug Code ด้วยตนเองแล้วแจ้งมาว่าบรรทัดไหนไม่ทำงาน หรือทำงานไม่ตรงกับที่ต้องการครับ

การใช้ Code จำเป็นต้อง Debug ให้เป็นไม่เช่นนั้นจะทำงานกับ VBA ได้อย่างลำบาก วิธีการ Debug Code ดูเบี้องต้นได้ตาม Link นี้ครับ https://snasui.com/viewtopic.php?f=3&t= ... 47#p103247

Code ที่เขียนควรทำให้คอลัมน์การค้นหาผันแปรไปตาม Item ที่เลือกใน ComboBox ไม่เช่นนั้นย่อมนำค่าต้นทางไปค้นได้ไม่ตรงกับคอลัมน์ปลายทาง

ก่อนการค้นหาทุกครั้งจะต้องยกเลิกการ Filter (ถ้ามี) ทิ้งเสียก่อน ตัวอย่าง Code บางส่วนตามด้านล่างครับ

Code: Select all

'Other code
'Remove filter from Database worksheet
    
If shDatabase.FilterMode = True Then
    shDatabase.AutoFilterMode = False
    shDatabase.ShowAllData
End If

'Apply filter on Database worksheet

If frmForm.cmbSearchColumn.value = "เลขทะเบียนรับ" Then

    shDatabase.Range("A1:K" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue

Else

    shDatabase.Range("A1:K" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"

End If

If Application.WorksheetFunction.Subtotal(3, shDatabase.Columns(iColumn)) >= 2 Then

    'Code to remove the previous data from SearchData worksheet
    
    shSearchData.Cells.Clear
    
    shDatabase.UsedRange.Copy shSearchData.Range("A1")
'Other code

[9KiTTi]

ควร Debug Code ด้วยตนเองแล้วแจ้งมาว่าบรรทัดไหนไม่ทำงาน หรือทำงานไม่ตรงกับที่ต้องการครับ

การใช้ Code จำเป็นต้อง Debug ให้เป็นไม่เช่นนั้นจะทำงานกับ VBA ได้อย่างลำบาก วิธีการ Debug Code ดูเบี้องต้นได้ตาม Link นี้ครับ viewtopic.php?f=3&t=17483&p=103247#p103247

Code ที่เขียนควรทำให้คอลัมน์การค้นหาผันแปรไปตาม Item ที่เลือกใน ComboBox ไม่เช่นนั้นย่อมนำค่าต้นทางไปค้นได้ไม่ตรงกับคอลัมน์ปลายทาง

ก่อนการค้นหาทุกครั้งจะต้องยกเลิกการ Filter (ถ้ามี) ทิ้งเสียก่อน ตัวอย่าง Code บางส่วนตามด้านล่างครับ

Code: Select all

'Other code
'Remove filter from Database worksheet
    
If shDatabase.FilterMode = True Then
    shDatabase.AutoFilterMode = False
    shDatabase.ShowAllData
End If

'Apply filter on Database worksheet

If frmForm.cmbSearchColumn.value = "เลขทะเบียนรับ" Then

    shDatabase.Range("A1:K" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue

Else

    shDatabase.Range("A1:K" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"

End If

If Application.WorksheetFunction.Subtotal(3, shDatabase.Columns(iColumn)) >= 2 Then

    'Code to remove the previous data from SearchData worksheet
    
    shSearchData.Cells.Clear
    
    shDatabase.UsedRange.Copy shSearchData.Range("A1")
'Other code

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

รบกวนอาจารย์แนะนำด้วยครับ ขอบพระคุณครับ

[snasui]

กรุณาแนบไฟล์ล่าสุดมาด้วยครับ

[9KiTTi]

กรุณาแนบไฟล์ล่าสุดมาด้วยครับ

ขออภัยครับอาจารย์ ผมลืมครับ

[snasui]

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

Code: Select all

'Other code
If shDatabase.FilterMode Then
    shDatabase.AutoFilterMode = False
    'shDatabase.ShowAllData
    shDatabase.ListObjects("Table2").AutoFilter.ShowAllData
End If
'Other code

ทั้งนี้เนื่องจากมีการใช้ Table แทน Range ธรรมดา อย่าลืมแก้ส่วนอื่นเช่นการแสดงข้อมูลบน Message Box ให้แสดงข้อมูลที่สอดคล้องกับที่เป็นจริงด้วยครับ

[9KiTTi]

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

Code: Select all

'Other code
If shDatabase.FilterMode Then
    shDatabase.AutoFilterMode = False
    'shDatabase.ShowAllData
    shDatabase.ListObjects("Table2").AutoFilter.ShowAllData
End If
'Other code

ทั้งนี้เนื่องจากมีการใช้ Table แทน Range ธรรมดา อย่าลืมแก้ส่วนอื่นเช่นการแสดงข้อมูลบน Message Box ให้แสดงข้อมูลที่สอดคล้องกับที่เป็นจริงด้วยครับ

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