3

我想过滤从存储在工作表中的值列表创建的列表框，具体取决于写入同一用户表单中包含的文本框中的文本。

我的列表框有 4 或 5 列（取决于 OptionField 选择），我想在所有列中搜索所写的文本。

示例：我在 TextField 中写入“aaa”，列表框应根据第 1 或 2 或 3 或 4 或 5 列包含“aaa”的所有行返回一个列表。

在我的代码下方刷新选项字段选择列表（此代码不会产生任何错误，它只是显示我如何创建我的列表）：

Sub RefreshList()

Dim selcell, firstcell As String
Dim k, i As Integer
Dim r as long
i = 0
k = 0

' reads parameters from hidden worksheet

If Me.new_schl = True Then

    firstcell = Cells(3, 4).Address
    selcell = firstcell

    Do Until IsEmpty(Range("" & selcell & "")) And i = 2
        If IsEmpty(Range("" & selcell & "")) Then i = i + 1
        k = k + 1
        selcell = Cells(1 + k, 7).Address(0, 0)
    Loop

        k = k - 1
        selcell = Cells(1 + k, 7).Address(0, 0)

    With Me.ListBox1

        .ColumnCount = 4
        .ColumnWidths = "50; 80; 160; 40"
        .RowSource = ""
        Set MyData = Range("" & firstcell & ":" & selcell & "")
        .List = MyData.Cells.Value

        For r = .ListCount - 1 To 0 Step -1
            If .List(r, 3) = "" Or .List(r, 3) = "0" Then
                .RemoveItem r
            End If
        Next r

    End With

Else

    firstcell = Cells(3, 11).Address
    selcell = firstcell

    Do Until IsEmpty(Range("" & selcell & "")) And i = 11
        If IsEmpty(Range("" & selcell & "")) Then i = i + 1
        k = k + 1
        selcell = Cells(1 + k, 15).Address(0, 0)
    Loop

        k = k - 1
        selcell = Cells(1 + k, 15).Address(0, 0)

    With Me.ListBox1

        .ColumnCount = 5
        .ColumnWidths = "40; 40; 160; 40; 40"
        .RowSource = ""
        Set MyData = Range("" & firstcell & ":" & selcell & "")
        .List = MyData.Cells.Value

        For r = .ListCount - 1 To 0 Step -1
            If .List(r, 3) = "" Or .List(r, 3) = "0" Then
                .RemoveItem r
            End If
        Next r

    End With

End If

End Sub
4

2 回答 2

1

我终于可以拿出一些东西了！

Sub Filter_Change()

Dim i As Long
Dim Str As String

Str = Me.Filter.Text

Me.RefreshList

If Not Str = "" Then
    With Me.ListBox1

        For i = .ListCount - 1 To 0 Step -1
            If InStr(1, LCase(.List(i, 0)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 1)), LCase(Str)) = 0 And _
              InStr(1, LCase(.List(i, 2)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 3)), LCase(Str)) = 0 Then

                .RemoveItem i

            End If
        Next i

    End With
End If

End Sub
于 2013-06-12T09:34:04.477 回答
1

我知道，答案是几年前...

但我想我会分享最适合我的解决方案，因为即使列表中有数千个项目，过滤器的速度也很快。但是，它并非没有“catch”：它使用 Dictionary 对象

Option Explicit
Dim myDictionary As Scripting.Dictionary

Private Sub fillListbox()
    Dim iii As Integer

    Set myDictionary = New Scripting.Dictionary

    ' this, here, is just a "draft" of a possible loop 
    ' for filling in the dictionary
    For iii = 1 To RANGE_END
        If Not myDictionary.Exists(UNIQUE_VALUE) Then
            myDictionary.Add INDEX, VALUE
        End If
    Next

    myListbox.List = myDictionary .Items

End Sub

Private Sub textboxSearch_Change()
    Dim Keys As Variant

    Keys = myDictionary .Items
    myListbox.List = Filter(Keys, textboxSearch.Text, True, vbTextCompare)

End Sub

Private Sub UserForm_Initialize()
    Call fillListbox
End Sub
于 2018-03-08T09:32:48.920 回答