组合框,其中可用选项是唯一的,并且取决于先前组合框中的选择

时间:2018-12-03 15:28:58

标签: excel vba

我在另一个文件中有一个数据集,该文件具有3列和数千行。所有3列的值都不唯一。

我需要3个组合框。

第一个组合框用于从“ A”列中选择(带回唯一的值)以用于不同类型的业务部门。

接下来,根据业务部门,组合框2用于选择特定客户(取决于所选业务部门)。

最后,组合框3用于从给定客户存在的不同成本中心中进行选择。

我需要为所有3列使用唯一值。

我想我的组合框1带有以下代码:

var result = AEnumerable.Select(e => new B
                {
                    FirstName = e.Forename,
                    LastName = e.Surname,
                    Dob = e.DateOfBirth
                }).ToList();

1 个答案:

答案 0 :(得分:0)

这是一种非常通用的方法-它只将数据加载一次到数组中,然后使用它来在选择“上一个”列表时重置列表内容。

Option Explicit

Const dataPath As String = "C:\Users\usernameHere\Desktop\tmp.xlsx"
Dim theData 'source data

Private Sub UserForm_Activate()
    LoadData
    Me.cboList1.List = GetList(1, "")
End Sub

Private Sub cboList1_Change()
    Me.cboList2.Clear
    Me.cboList2.List = GetList(2, Me.cboList1.Value)
    Me.cboList3.Clear
End Sub

Private Sub cboList2_Change()
    Me.cboList3.Clear
    Me.cboList3.List = GetList(3, Me.cboList2.Value)
End Sub

'Return unique values from source data, given a specific column
'  If given a value for "restrictTo", filter on match in column to "left"
'  of the requested value column
Function GetList(colNum As Long, restrictTo)
    Dim i As Long, n As Long, rv()
    Dim dict As Object, v, ub As Long, inc As Boolean

    Set dict = CreateObject("scripting.dictionary")
    ub = UBound(theData, 1)
    ReDim rv(1 To ub) 'will set final size after filling...
    n = 0

    For i = 1 To ub

        v = theData(i, colNum)
        'are we restricting the values we collect based on a different list?
        If colNum > 1 And Len(restrictTo) > 0 Then
            'is this value valid?
            inc = (theData(i, colNum - 1) = restrictTo)
        Else
            inc = True 'collect all values
        End If

        If inc And Not dict.exists(v) Then
            'don't already have this value - add to array and dict
            n = n + 1
            dict.Add v, True
            rv(n) = v
        End If

    Next i
    ReDim Preserve rv(1 To n) 'resize array to size of content
    GetList = rv
End Function

'load data from external file
Private Sub LoadData()
    With Workbooks.Open(dataPath).Worksheets("#2Table_Revenue")
        theData = .Range(.Range("A8"), _
                         .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2)).Value
        .Parent.Close False
    End With
End Sub