VBA excel：调整Listbox.Height问题（如何在按下的按键上执行即时search，并即时显示匹配）

我有一个带有下面的计划的文本框和列表框的用户窗体：

1. 用户在Textbox1input文本。
2. 每当Textbox1.Text更改时，将执行具有以下function的search：
   • 在工作表中的特定范围内searchTextbox1.Text 。
   • Textbox1.Text可以被发现不止一次。
   • Listbox1填充search结果。

到目前为止这么好。 由于有大量的数据，这个列表可以得到很多项目。 在这种情况下，列表超出了屏幕，我不得不限制Listbox1.Height 。 这是上面的代码：

 Private Sub TextBox1_Change() Dim srchWord As String, firstAddress As String Dim srchRng As Range, cell As Range Dim maxRow As Integer ListBox1.Clear If TextBox1.Value = "" Then ListBox1.Height = 0 Else With ThisWorkbook.Worksheets(1) maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row Set srchRng = .Range("A2:A" & maxRow) End With srchWord = TextBox1.Value Set cell = srchRng.Find(srchWord, LookIn:=xlValues, lookat:=xlPart) With ListBox1 If Not cell Is Nothing Then firstAddress = cell.Address Do If Not cell.Value Like "*(*" Then .AddItem (cell.Value) Select Case .ListCount Case Is < 2 .Height = 17 Case Is < 21 .Height = 15 * .ListCount Case Else .Height = 272.5 End Select Me.Height = 500 End If Set cell = srchRng.FindNext(cell) Loop While Not cell.Address = firstAddress End If End With End If End Sub 

问题是在滚动启用时，我不能达到列表的最后一个项目。 通过在网上search，我发现了一些潜在的解决scheme：

• 设置Listbox1.IntegralHeight = False设置高度，然后再次设置Listbox1.IntegralHeight = True
• 设置Listbox1.MultiSelect = fmMultiSelectSingle ，然后再次设置Listbox1.MultiSelect = fmMultiSelectExtended 。
• 做以上两个。
• Application.Wait (Now + TimeValue("0:00:01") * 0.5)然后设置高度。

这些都没有工作。 为了能够滚动到最后一个项目，这工作：

 Listbox1.IntegralHeight = False Listbox1.Height= x Listbox1.IntegralHeight = False Listbox1.Height= x 

但是这也将Listbox1.Height设置为一个单一的项目。 （右箭头）

有没有人知道我要如何控制ListBox1.Height没有所有这些不需要的行为？ 另外如果有人可以build议另一个结构，可以按照上面提到的计划，我愿意放弃列表框。

Answer 1

这似乎是一个不完全探索的行为。

• 根据我的经验，重新定义一些列表框参数。

• 尝试推荐将.IntegralHeight设置为False和True。

• 另一种可能的措施可以帮助在某些情况下：尝试select高度为您的列表框接近下面的乘法：

listbox height =（字体大小+ 2分）*（每页最多的项目）

With ListBox1后插入以下代码：

  With ListBox1 .Top = 18 ' << redefine your starting Point .Font.Size = 10 ' << redefine your font size .IntegralHeight = False ' << try the cited recommendation :-) 

在 End With 之前插入以下代码：

  .Height = .Height + .Font.Size + 2 .IntegralHeight = True End With 

希望有所帮助。

链接

另请参阅另一个更快的方法来筛选列表框在如何加快在用户表单Excel中的列表框值的填充

Answer 2

@TM：感谢您的快速响应和您的时间。 你的回答给了我想要的东西，这就是为什么我要这样做。 我发布这只是为了将来的参考。

我最终做了什么来实施这个计划。

• 首先我插入：

这个

 With ListBox1 .Top = 18 .Font.Size = 10 .IntegralHeight = False 

和这个

  .Height = .Height + .Font.Size + 2 .IntegralHeight = True End With 

我和你build议的.Font.Size链接。 只要不需要为高度指定绝对值，就不需要在代码中有Select Case语句。

• 而且我意识到，每次添加项目时都不需要改变高度，而只需要在stream程结束时更改高度，所以我把它从循环中取出。

• 最后，我添加了一段代码，当Textbox1为空时，这个代码将不可见。 代码现在是这样的：

最终用户表单代码：

 Option Compare Text Option Explicit Private bsdel As Boolean 'indicates if backspace or delete keys have been hit. Private Sub ListBox1_Click() Dim cell As Range Dim maxRow As Integer With ThisWorkbook.Worksheets(1) maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row Set cell = .Range("A1:A" & maxRow).Find(UserForm11.ListBox1.Text, LookIn:=xlValues, lookat:=xlWhole) If Not cell Is Nothing Then cell.Select 'do other stuff also. End If End With End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) bsdel = False If KeyCode = 8 Or KeyCode = 46 Then _ bsdel = True End Sub Private Sub TextBox1_Change() Dim srchWord As String, firstAddress As String Dim srchRng As Range, cell As Range Dim maxRow As Integer ListBox1.Clear ListBox1.Visible = True If bsdel And TextBox1.Value = "" Then ListBox1.Visible = False Me.Height = 130 Else With ThisWorkbook.Worksheets(1) maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row Set srchRng = .Range("A1:A" & maxRow) End With srchWord = TextBox1.Value Set cell = srchRng.Find(srchWord, LookIn:=xlValues, lookat:=xlPart) With ListBox1 '.Top = 84 'test made: deleting this made no difference. '.Font.Size = 10 'test made: deleting this made no difference. .IntegralHeight = False If Not cell Is Nothing Then firstAddress = cell.Address Do If Not cell.Value Like "*(*" Then 'this range includes notes within parenthesis and I didn't need them. .AddItem (cell.Value) End If Set cell = srchRng.FindNext(cell) Loop While Not cell.Address = firstAddress If .ListCount < 21 Then 'the size is adjusted. .Height = (.Font.Size + 2) * .ListCount Else 'the size stays fixed at maximum. .Height = (.Font.Size + 2) * 20 End If End If Me.Height = .Height + 130 .Height = .Height + .Font.Size + 2 .IntegralHeight = True End With End If bsdel = False End Sub Private Sub UserForm_Activate() TextBox1.SetFocus End Sub Private Sub UserForm_Initialize() ListBox1.Visible = False End Sub