Question

我想在工作表中过滤结果并使用此结果创建Listbox，这个代码适用于工作表上的列表框但不适用于表单，任何想法？

Sub MyListBox()

Dim rng As Range
Dim vArr As Variant
Dim ListBox1 As Object ---> this works on sheet but not works on form

Dim x As Single
Dim y As String
y = Worksheets("Sheet2").Cells(1, 12).Value
x = Worksheets("Sheet2").Cells(2, 12).Value
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set rng = Range("TestMaterial")

Set ListBox1 = ActiveSheet.OLEObjects(1).Object ---> this works on sheet but not works on form

rng.AutoFilter field:=13, Criteria1:=y
rng.AutoFilter field:=12, Criteria1:=x

Worksheets.Add
rng.SpecialCells(xlCellTypeVisible).Copy Range("a1")

vArr = ActiveSheet.UsedRange

With ListBox1
   .List = (vArr)
End With

ActiveSheet.Delete
Worksheets("TRAINING").AutoFilterMode = False
'rng.AutoFilter.Clear


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

我找到了这段代码，但是这会创建新的列表框，但是没有用数据填充列表框，只有标题，找不到错误的内容以及如何使用此代码填充现有的列表框？

Sub MyListBox()
Dim rng As Range
Dim vArr As Variant

    Dim ListBox1 As MSForms.Control
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set rng = Range("TestMaterial")
     Set ListBox1 = frmplan.Controls.Add("Forms.ListBox.1")  ---> adds new   Listbox to form even I have some one with name "Listbox1"

 rng.AutoFilter field:=13, Criteria1:=txtsdept.Value
rng.AutoFilter field:=12, Criteria1:=txtsgrade


Worksheets.Add
rng.SpecialCells(xlCellTypeVisible).Copy Range("a1")

vArr = ActiveSheet.UsedRange

    With ListBox1

    .List = (vArr)
End With

ActiveSheet.Delete
Worksheets("TRAINING").AutoFilterMode = False



Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

Answer 1

针对“Userform”案例尝试以下代码：

Sub MyListBox()
    With Range("TestMaterial")
        .AutoFilter Field:=13, criteria1:=txtsdept.value
        .AutoFilter Field:=12, criteria1:=txtsgrade
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then FillListBox .SpecialCells(xlCellTypeVisible), Me.ListBox1
        .Parent.AutoFilterMode = False
    End With
End Sub

Sub FillListBox(filteredRng As Range, LB As msforms.ListBox)
    Dim vArr As Variant

    vArr = GetArray(filteredRng) '<--| fill array
    With LB
        .ColumnCount = UBound(vArr, 2)
        .List = vArr
    End With
End Sub

Function GetArray(filteredRng As Range) As Variant
    Dim calculation As XlCalculation

    ApplicationBoost True, calculation '<--| boost application "up"
    With filteredRng
        Worksheets.Add
        .Copy Range("A1")
        GetArray = ActiveSheet.UsedRange '<--| fill returned array

        Application.DisplayAlerts = False '<--| disable alerts for what strictly needed
        ActiveSheet.Delete
        Application.DisplayAlerts = True '<--| enable alerts back
    End With
    ApplicationBoost False, calculation '<--| boost application "back"    
End Function

Sub ApplicationBoost(boost As Boolean, calculation As XlCalculation)
    With Application
        If boost Then
            calculation = .calculation '<--| retrieve current calculation setting
            .calculation = xlCalculationManual '<--| turn calculation off
        Else
            .calculation = calculation '<--| restore current calculation setting
        End If
        .ScreenUpdating = Not boost
        .EnableEvents = Not boost
    End With
End Sub

正如您所看到的，我重构了您的代码并将更多的内容拆分，您可以更轻松地处理这些内容并增强和维护代码

创建具有过滤值vba excel的列表框

1 个答案: