如何从rowsource范围设置变量数组?

时间:2014-06-02 05:21:09

标签: vba excel-vba excel

我是vba的新手。我有一个列表框。它工作正常但直到最近出现错误" -2147467259(80004005) 无法设置rowSource属性。未指定的错误"蹦出来。通常,我将不得不重新启动excel。

编辑:当我多次过滤我的代码时实现。发生错误。

我有一个listbox2,在UserForm_Initialize()中,我填充了listbox1中的所有数据,除了我在填充数据之前过滤它们。

    Dim rData  As Range

    With Sheet1
    Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 8).End(xlUp))
    .AutoFilterMode = False
    rData.AutoFilter Field:=8, Criteria1:="-"

    'Header
    On Error Resume Next
    Set rSource = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    .AutoFilterMode = False
    On Error GoTo 0

    '~~> Use Sheet2 here or a temporary sheet for listbox display purpose only
    Sheet6.Cells.ClearContents
    rSource.Copy Sheet6.Cells(1, 1)

    Set rSource = Sheet6.Range(Sheet6.Cells(1, 1) _
                    , Sheet6.Cells(Sheet6.Rows.Count, 8).End(xlUp))
    Set rSource = rSource.Offset(1, 0).Resize(rSource.Rows.Count - 1, _
                                              rSource.Columns.Count)
    End With

    DoEvents '~~> Again this is a must to visually update ListBox display
    ListBox2.RowSource = rSource.Address(external:=True)
    LoadInterface2

在表6中(Todiscard纸箱)是另一个仅用于列表框显示的临时表单

 Private Sub LoadInterface2()
    Dim rCombo1 As Range
    Dim rCombo2 As Range
    Dim rCombo3 As Range
    Dim rCombo4 As Range
    Dim rCombo5 As Range
    Dim rCombo6 As Range
    Dim col    As Long
    Dim col2   As Long
    Dim LastRw As Long


    Application.ScreenUpdating = False


    With Worksheets("ToDiscard Cartons")
        LastRw = .UsedRange.Rows.Count
        'create unique lists for combos using advanced filter
        Range("IM:IV").EntireColumn.ClearContents
        For col = 1 To 6
            col2 = Choose(col, 248, 250, 252, 254, 256, 258)
            .Range(.Cells(1, col), .Cells(LastRw, col)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, col2), Unique:=True
        Next col
        Set rSource = .Range(.Cells(2, 1), .Cells(LastRw, 8))
        Set rCombo1 = .Range(.Cells(2, 248), .Cells(.Rows.Count, 248).End(xlUp))
        Set rCombo2 = .Range(.Cells(2, 250), .Cells(.Rows.Count, 250).End(xlUp))
        Set rCombo3 = .Range(.Cells(2, 252), .Cells(.Rows.Count, 252).End(xlUp))
        Set rCombo4 = .Range(.Cells(2, 254), .Cells(.Rows.Count, 254).End(xlUp))
        Set rCombo5 = .Range(.Cells(2, 256), .Cells(.Rows.Count, 256).End(xlUp))
        Set rCombo6 = .Range(.Cells(2, 258), .Cells(.Rows.Count, 258).End(xlUp))

        With Me
            .ListBox2.RowSource = rSource.Address(external:=True)
            .ComboBox1.RowSource = rCombo1.Address(external:=True)
            .ComboBox2.RowSource = rCombo2.Address(external:=True)
            .ComboBox3.RowSource = rCombo3.Address(external:=True)
            .ComboBox4.RowSource = rCombo4.Address(external:=True)
            .ComboBox5.RowSource = rCombo5.Address(external:=True)
            .ComboBox6.RowSource = rCombo6.Address(external:=True)

        End With

        For Each oCtrl In Me.Controls
            If TypeOf oCtrl Is MSForms.ComboBox Then oCtrl.ListIndex = -1
        Next oCtrl
    End With
    Application.ScreenUpdating = True

End Sub

单击SEARCH按钮时,下面是我的代码

Private Sub CommandButton1_Click() 'Search button
    Dim rData  As Range

    With Sheet6 'ToDiscard cartons worksheet = sheet6

        Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 8).End(xlUp))

        If Not .AutoFilterMode Then .Cells(1, 1).AutoFilter
        .Cells(1, 1).AutoFilter Field:=lFld, Criteria1:=">=" & sCrit, Operator:=xlAnd, Criteria2:="<=" & sCrit2

        'Header
        On Error Resume Next
        Set rSource = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

        ActiveSheet.AutoFilterMode = False

        On Error GoTo 0
        .Cells(1, 200).CurrentRegion.ClearContents
        rSource.Copy .Cells(1, 200)

        Set rSource = .Cells(2, 200).CurrentRegion
        Set rSource = rSource.Offset(1, 0).Resize(rSource.Rows.Count - 1, _
                                                  rSource.Columns.Count)
    End With

    With Me.ListBox2
        .RowSource = ""
        .RowSource = rSource.Address(external:=True)
    End With

End Sub

单击重置按钮时,下面是我的代码

Private Sub CommandButton2_Click()  'Reset button
    UserForm_Initialize
End Sub

1 个答案:

答案 0 :(得分:0)

要为 Listbox和Combobox 分配值数组,您可以尝试:

With Me
    .ListBox1.List = Application.Transpose(Application.Transpose(rSource))
    .ComboBox1.List = Application.Transpose(rCombo1)
    .ComboBox2.List = Application.Transpose(rCombo2)
    .ComboBox3.List = Application.Transpose(rCombo3)
    .ComboBox4.List = Application.Transpose(rCombo4)
    .ComboBox5.List = Application.Transpose(rCombo5)
    .ComboBox6.List = Application.Transpose(rCombo6)
End With