调整Excel用户表单列表框中的垂直滚动条范围

Question

我有一个动态多列列表框，其范围可以从 1 到 100 行。用户窗体具有固定高度，因此需要时会显示垂直滚动条。

当列出 100 行时，滚动条会识别出其中有 500-600 行，从而导致底部出现空白区域。

如何设置滚动条自动适合列出的行数？

填充列表框的代码：

Sub RefreshLBIndoor()
    Dim i As Integer, j As Integer, k As Byte
    With ListBoxIndoor ' This is the listbox name
        .ColumnCount = 6
        j = 1
        For i = 3 To SupportList.ListObjects("ProductList_table").DataBodyRange.Rows.Count + 2 ' Data begins from row 3
            ' Column F (number 6) contains the filter for which rows to populate the listbox
            If InStr(1, SupportList.Cells(i, 6), "Example", vbTextCompare) = 1 Then 
                For k = 3 To 8
                    .AddItem
                    .Column(k - 3, j - 1) = SupportList.Cells(i, k).Value
                Next k
                j = j + 1
            End If
        Next i
        On Error Resume Next
        .ListIndex = 0
    End With
End Sub

Answer 1

问题是为每行的每列添加一个项目。 将 .AddItem 移动到列循环之外修复了问题。 我还添加了 .Clear 以在刷新时清除列表框。

Sub RefreshLBIndoor()
    Dim i As Integer, j As Integer, k As Byte
    With ListBoxIndoor ' This is the listbox name
        Rem Clear the listbox when you refresh it
        .Clear
        .ColumnCount = 6
        j = 1
        For i = 3 To SupportList.ListObjects("ProductList_table").DataBodyRange.Rows.Count + 2 ' Data begins from row 3
            ' Column F (number 6) contains the filter for which rows to populate the listbox
            If InStr(1, SupportList.Cells(i, 6), "Example", vbTextCompare) = 1 Then
                Rem AddItem once per row
                .AddItem
                For k = 3 To 8
                    .Column(k - 3, j - 1) = SupportList.Cells(i, k).Value
                Next k
                j = j + 1
            End If
        Next i
        On Error Resume Next
        .ListIndex = 0
    End With
End Sub

这是我的答案的改进版本，它利用了存储在 ListObject 中的数据：

Sub RefreshLBIndoor()
    Rem use Long for your counters
    Dim r As Long, c As Long
    
    Dim Values As Variant
    With ListBoxIndoor ' This is the listbox name
        Rem Clear the listbox when you refresh it
        .Clear
        .ColumnCount = 6
        Rem Load the Values into an array to improve efficiency
        Values = SupportList.ListObjects("ProductList_table").DataBodyRange.Value
        For r = 1 To SupportList.ListObjects("ProductList_table").ListRows.Count
            If InStr(1, SupportList.Cells(r, 6), "Example", vbTextCompare) = 1 Then
                Rem AddItem once per row
                .AddItem
                For c = 3 To 8
                    .Column(c - 3, .ListCount - 1) = Values(r, c)
                Next
            End If
        Next
        On Error Resume Next
        .ListIndex = 0
    End With
End Sub