EXCEL VBA 窗体:员工信息查询系统

' ================== 查询按钮 ==================Private Sub btnSearch_Click()    Dim ws As Worksheet    Dim i As Long, j As Long    Dim matchRow As Boolean    Dim cnt As Long    Set ws = ThisWorkbook.Worksheets(DATA_SHEET)    ' ----- 读取并处理条件 -----    Dim nameFilter As String: nameFilter = Trim(txtName.Text)    Dim deptFilter As String: deptFilter = cboDept.Text    Dim dateFrom As Date, dateTo As Date    Dim hasDateFrom As Boolean, hasDateTo As Boolean    hasDateFrom = IsDate(txtDateFrom.Text)    hasDateTo = IsDate(txtDateTo.Text)    ' 使用 DateValue 去掉可能的时间部分    If hasDateFrom Then dateFrom = DateValue(CDate(txtDateFrom.Text))    If hasDateTo Then dateTo = DateValue(CDate(txtDateTo.Text))    ' ----- 将数据读入数组（一次性读取，速度快）-----    Dim dataArr As Variant    dataArr = ws.Range(ws.Cells(dataStartRow, 1), ws.Cells(lastRow, lastCol)).Value    ' 准备存储结果的数组（最后一列存行号，前面存显示数据）    Dim outArr() As Variant    ReDim outArr(1 To UBound(dataArr, 1), 1 To lastCol + 1)    cnt = 0    ' 清空旧的行号映射    rowIndexMap.RemoveAll    ' ----- 遍历每一行数据 -----    For i = 1 To UBound(dataArr, 1)        matchRow = True        ' --- 姓名模糊匹配 (第1列) ---        If Len(nameFilter) > 0 Then            If InStr(1, CStr(dataArr(i, 1)), nameFilter, vbTextCompare) = 0 Then                matchRow = False            End If        End If        ' --- 部门精确匹配 (第2列) ---        If matchRow And Len(deptFilter) > 0 Then            If StrComp(CStr(dataArr(i, 2)), deptFilter, vbTextCompare) <> 0 Then                matchRow = False            End If        End If        ' --- 日期范围 (第3列) - 修正版：>=起始 且 <=结束 ---        If matchRow Then            Dim rowDateRaw As Variant            rowDateRaw = dataArr(i, 3)            If IsDate(rowDateRaw) Then                Dim pureRowDate As Date                pureRowDate = DateValue(CStr(rowDateRaw))  ' 去掉时分秒                If hasDateFrom Then                    If pureRowDate < dateFrom Then matchRow = False                End If                If hasDateTo Then                    If pureRowDate > dateTo Then matchRow = False                End If            Else                ' 不是日期的单元格，如果设置了日期筛选条件则视为不匹配                If hasDateFrom Or hasDateTo Then matchRow = False            End If        End If        ' ---------- 可在此继续添加其它列条件 ----------        ' ----- 如果符合条件，保存该行数据及行号 -----        If matchRow Then            cnt = cnt + 1            ' 第一列存真实行号（dataStartRow + i - 1）            outArr(cnt, 1) = dataStartRow + i - 1            For j = 1 To lastCol                outArr(cnt, j + 1) = dataArr(i, j)            Next j            ' 记录映射：ListBox 索引(0-based) -> 源行号            rowIndexMap(cnt - 1) = dataStartRow + i - 1        End If    Next i    ' ----- 显示结果到 ListBox -----    lstResult.Clear    If cnt > 0 Then        ' 截取有效行        Dim finalArr() As Variant        ReDim finalArr(1 To cnt, 1 To lastCol + 1)        For i = 1 To cnt            For j = 1 To lastCol + 1                finalArr(i, j) = outArr(i, j)            Next j        Next        lstResult.List = finalArr        ' 调整列宽（第一列宽度0已预设，此处调整可见列）        AutoFitVisibleColumns    Else        MsgBox "没有找到匹配的记录。", vbInformation, "提示"    End IfEnd Sub