从2个组合框选择中填充列表框

时间:2016-03-03 01:44:13

标签: excel vba

这是我到目前为止所拥有的。我尝试根据用户在用户表单中进行的2个组合框选择来填充我的列表框。

Private Sub Product_Type_Box_Change()
Dim Products_List As String
Dim M As Integer
Dim Manufacturers As String
Dim Product_Type As String
Dim DCSProgram2 As Workbook
Dim MLast As Long
Dim PLast As Long
Dim p As Integer

Set DCSProgram2 = ActiveWorkbook
Manufacturers = Me.MFG_Box.Value
Product_Type = Me.Product_Type_Box.Value

With DCSProgram2.Sheets("MFG_DATA")
    MLast = .Cells(.Rows.Count, 1).End(xlUp).Row
        For M = 1 To MLast
           PLast = .Cells(.Rows.Count, 2).End(xlUp).Row
               For p = 1 To PLast
                   If .Cells(M, 1).Value = Manufacturers And .Cells(p, 1).Value = Product_Type Then
                      With Products_Box
                          .AddItem "yay it works"


                      End With
                   End If
                Next p
            Next M

 End With
 End Sub

我已经尝试使用And语句填充列表框,并且我的变量Manufacturers取得了成功。以下是我的数据的示例。

Item    Manufacturers   Product Type   Other Data
 1        MFG 1           Tools           4558
 2        MFG 2           Parts           4455
 3        MFG 1           Tools           4585
 4        MFG 3           Screws          6845

因此if Manufacturers = MFG 1 and Productype = Tools then Products_Box的值为yay it works。如果我最终可以计算出这部分,我想在列表框中列出我的电子表格中的数据,这样用户就可以选择多个条目中的一个。如果我能说得更清楚,请告诉我。

谢谢,

杰夫

1 个答案:

答案 0 :(得分:0)

如果Products_Box是同一UserForm上的其他列表框,那么您之前错过了Me.

此外,如果我的目标正确,我会指出以下内容:

  • 你不必要地循环

  • 范围类型AutoFilter方法非常方便

  • Products_Box MFG_Box事件

  • 需要_Change次治疗

对于以上所有内容,我将重构您的代码,如下所示

Option Explicit

Private Sub MFG_Box_Change()

Call UpdateProduct_Box

End Sub

Private Sub Product_Type_Box_Change()

Call UpdateProduct_Box

End Sub

Private Sub UpdateProduct_Box()
Dim Manufacturers As String
Dim Product_Type As String

Dim dataDB As Range

With Me
    If .MFG_Box.ListIndex < 0 Or .Product_Type_Box.ListIndex < 0 Then Exit Sub

    Manufacturers = .MFG_Box.Value
    Product_Type = .Product_Type_Box.Value
End With

With ActiveWorkbook.Sheets("MFG_DATA") '<== be sure which workbook you want to refer to: ActiveWorkbook (the one whose window is currently active in excel session) or ThisWorkbook (the one in which this macro resides)
    Set dataDB = .Range("A1:D1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
End With

With dataDB
    .AutoFilter Field:=2, Criteria1:=Manufacturers ' filter data on Manufacturer
    .SpecialCells(xlCellTypeVisible).AutoFilter Field:=3, Criteria1:=Product_Type ' filter data again on Product Type
    Call UpdateListBox(Me.Products_Box, dataDB, 4)
    .AutoFilter 'remove filters
End With

End Sub


Sub UpdateListBox(LBToFill As MSForms.ListBox, dataDB As Range, columnToList As Long)
Dim cell As Range, dataValues As Range

With LBToFill
    If dataDB.SpecialCells(xlCellTypeVisible).Count > dataDB.Columns.Count Then 'if all data rows have been hidden then there last headers only, which count up to data columns number
        Set dataValues = dataDB.Offset(1).Resize(dataDB.Rows.Count - 1)
       .Clear ' clear listbox before adding new elements
        For Each cell In dataValues.Columns(columnToList).SpecialCells(xlCellTypeVisible)
            .AddItem cell.Value
        Next cell
    Else
        .Clear ' no match -> clear listbox
    End If
End With

End Sub