Question

我在Word模板中有一个用户表单，上面有一个列表框。列表框初始化为从主文件夹中读取的文件夹名称列表，用户可以从此列表中选择一个。目前，该列表大约有十几个条目，因此向下滚动不是问题，但我被告知最终列表大约为250，这使得滚动有点弱。

如何添加用户可以在参考编号中键入的文本字段[文件夹名称是参考编号后跟产品名称]，然后过滤列表供他们选择？

我想我需要将文件夹列表加载到数组而不是列表框中，然后是文本字段内容将过滤的函数，并减少列表框中的列表。

Answer 1

我有非常相似的请求，我添加了我为处理该问题而编写的代码。逻辑非常相似。另外，我正在使用excel所以我有更新所有搜索值的工作表（“你的数据库工作表”）我也将结果填充到列表视图而不是列表框，但填充到列表框要容易得多。另请注意，我传递给函数'columnNum'的参数是因为用户可以通过多个搜索参数（序列号，产品名称等）进行搜索。另外，因为你没有使用excel，替换dataBase工作表的可能解决方案是用所有参数定义多元数组，并用第二个数组搜索它 - 就像下面代码中的'dbarray'一样。如果您要添加代码，则可以将此逻辑转换为宏

     Public Function Search(ByVal columnNum As Byte, ByVal StringToSearch As  String) As Integer

     Dim numOfResults As Integer

     Dim lrdatabase As Long
     Dim dbarray() As Variant
     lrdatabase = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(Rows.Count, 8).End(xlUp).Row

' count how many results in order to preserve them in the next loop
Dim counter As Integer
For X = 2 To lrdatabase
If ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, columnNum).Value Like "*" & StringToSearch & "*" Then
counter = counter + 1
End If
Next X

If counter = 0 Then
' there are no results
MsgBox "no result found" & vbCrLf & vbCrLf & vbCrLf & "please note the search value is case sensitive", vbInformation + vbMsgBoxRight, "àéï úåöàåú"
     Search = 0
Exit Function
Else
numOfResults = counter
' because there are results the listview will clean
ClenListView
End If


ReDim Preserve dbarray(o To counter, 0 To 10) As Variant
counter = 0

For X = 2 To lrdatabase
If ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, columnNum).Value Like "*" & StringToSearch & "*" Then
dbarray(counter, 0) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 9).Value
dbarray(counter, 1) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 10).Value
dbarray(counter, 2) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 11).Value
dbarray(counter, 3) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 12).Value
dbarray(counter, 4) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 13).Value
dbarray(counter, 5) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 14).Value
dbarray(counter, 6) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 15).Value
dbarray(counter, 7) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 16).Value
dbarray(counter, 8) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 17).Value
dbarray(counter, 9) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 18).Value
dbarray(counter, 10) = ThisWorkbook.Sheets("your dataBase WorkSheet").Cells(X, 19).Value

counter = counter + 1
End If
Next X


'listview shape
With ListView1
.View = lvwReport
.Gridlines = True
.FullRowSelect = True
   End With

   ' add header / headers text
HeadersForListView


' fill rows
'add items(first column) and sub items(the rest of the columns)
Dim itm As ListItem
   Dim rowndx As Long
   For rowndx = LBound(dbarray, 1) To UBound(dbarray, 1) - 2
   Set itm = ListView1.ListItems.Add
 itm = dbarray(rowndx, 0)
    itm.SubItems(1) = dbarray(rowndx, 1)
    itm.SubItems(2) = dbarray(rowndx, 2)
    itm.SubItems(3) = dbarray(rowndx, 3)
    itm.SubItems(4) = dbarray(rowndx, 4)
    itm.SubItems(5) = dbarray(rowndx, 5)
    itm.SubItems(6) = dbarray(rowndx, 6)
    itm.SubItems(7) = dbarray(rowndx, 7)
  itm.SubItems(8) = dbarray(rowndx, 8)
    itm.SubItems(9) = dbarray(rowndx, 9)
   itm.SubItems(10) = dbarray(rowndx, 10)

   Next rowndx



Me.ListView1.LabelEdit = lvwManual 'prevent the user to change the item text on the listview
Erase dbarray()
Search = numOfResults
End Function

如何使用过滤器字段来搜索列表框vba

1 个答案: