调整 Listbox.Height 个问题

Question

我有一个带有文本框和列表框的用户表单，计划如下：

用户在 Textbox1 中输入文本。
每次 Textbox1.Text 更改时，都会执行具有以下功能的搜索：
- Textbox1.Text 在工作表的特定范围内搜索。
- Textbox1.Text可以多次找到
- Listbox1 填充了搜索结果。

到目前为止一切顺利。由于拥有大量数据，列表可以得到很多项目。在这种情况下，列表超出了屏幕，我不得不限制 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

问题出在 Case Else 启用滚动时我无法到达列表的最后一项。通过在网上搜索，我找到了一些可能的解决方案：

设置Listbox1.IntegralHeight = False设置高度然后再设置Listbox1.IntegralHeight = True
设置Listbox1.MultiSelect = fmMultiSelectSingle然后再次设置Listbox1.MultiSelect = fmMultiSelectExtended.
执行以上两项操作。
Application.Wait (Now + TimeValue("0:00:01") * 0.5)然后设置高度。

None 其中有效。为了能够滚动到最后一项，这有效：

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

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

有谁知道我到底要如何控制 Listbox1.Height 而没有所有这些不良行为？此外，如果有人可以建议另一种结构可以遵循最初提到的计划，我愿意放弃列表框。

Answer 1

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

根据我的经验，只需重新定义一些列表框参数即可。
尝试使用推荐的 .IntegralHeight 组来判断真假。
另一种可能的措施在某些情况下会有所帮助：尝试为您的列表框选择接近以下乘法的高度：

listbox height = (font size + 2 pts) * (maximum items per page)

在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

希望对您有所帮助。

Link

在

查看另一种更快的筛选列表框的方法

Answer 2

@T.M.: 感谢您的快速回复和宝贵时间。您的回答正是我想要的，这就是为什么我将其标记为这样的原因。我发布这个只是为了将来参考。

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

首先我插入：

这个

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

还有这个

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

并且我按照您的建议将 .Height 链接到 .Font.Size。只要不需要为高度分配绝对值，我的代码中就不需要 Select Case 语句。

此外，我意识到无需在每次添加项目时更改高度，而只需在过程结束时更改高度，因此我将其从循环中取出。
最后我添加了一段代码，可以在 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

调整 Listbox.Height 个问题

Adjust Listbox.Height problems

excel

height

vba

listbox