Userform度用keyword搜ws的資料放係listbox的方法

我試過呢個唔太work

Option Explicit

Private Sub SearchRecords()

Dim ws As Worksheet

Dim lastRow As Long

Dim dataArr As Variant

Dim resultArr() As Variant

Dim i As Long, j As Long, matchCount As Long

Dim searchKey As String

Dim tempDate As Variant, tempDetail As Variant



On Error GoTo ErrorHandler



' 1. 取得關鍵字

searchKey = Trim(Me.FileNo.Text)

If searchKey = "" Then

    Me.ListBox1.Clear

    Exit Sub

End If



' 2. 指定工作表

Set ws = ThisWorkbook.Worksheets("past")

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

If lastRow < 2 Then

    Me.ListBox1.Clear

    Exit Sub

End If



' 3. 讀入記憶體陣列加速處理

dataArr = ws.Range("A2:C" & lastRow).Value



' 4. 設定 ListBox 格式：只顯示 2 欄 (Col A 日期時間, Col C Detail)

With Me.ListBox1

    .Clear

    .ColumnCount = 2

    .ColumnWidths = "120 pt;250 pt" ' 依畫面寬度自行微調

End With



' 5. 篩選完全吻合的記錄

ReDim resultArr(1 To 2, 1 To UBound(dataArr, 1))

matchCount = 0



For i = 1 To UBound(dataArr, 1)

    ' StrComp = 0 代表文字完全一致（vbTextCompare 忽略大小寫；如需分大小寫請改用 vbBinaryCompare）

    If StrComp(Trim(CStr(dataArr(i, 2))), searchKey, vbTextCompare) = 0 Then

        matchCount = matchCount + 1

        resultArr(1, matchCount) = dataArr(i, 1) ' 日期時間

        resultArr(2, matchCount) = dataArr(i, 3) ' Detail

    End If

Next i



' 若無匹配記錄則結束

If matchCount = 0 Then Exit Sub



' 縮減陣列至實際筆數

ReDim Preserve resultArr(1 To 2, 1 To matchCount)



' 6. 依日期時間由新到舊排序（Bubble Sort，適合清單資料量）

If matchCount > 1 Then

    For i = 1 To matchCount - 1

        For j = i + 1 To matchCount

            ' 如果後面的時間比前面新，就對調

            If CDate(resultArr(1, j)) > CDate(resultArr(1, i)) Then

                tempDate = resultArr(1, i)

                tempDetail = resultArr(2, i)

                

                resultArr(1, i) = resultArr(1, j)

                resultArr(2, i) = resultArr(2, j)

                

                resultArr(1, j) = tempDate

                resultArr(2, j) = tempDetail

            End If

        Next j

    Next i

End If



' 7. 填入 ListBox

For i = 1 To matchCount

    With Me.ListBox1

        .AddItem Format(resultArr(1, i), "yyyy-mm-dd hh:mm") ' 格式化時間

        .List(i - 1, 1) = CStr(resultArr(2, i))              ' Detail

    End With

Next i



Exit Sub

ErrorHandler:

MsgBox "搜尋處理時發生錯誤：" & Err.Description, vbCritical, "錯誤"

End Sub