在级联组合框上出现错误

Getting errors on cascading comboboxes

提问人:Yodelayheewho 提问时间:10/6/2023 更新时间:10/6/2023 访问量:26

问:

非常缺乏经验,并找到了级联组合框的代码。我尝试解决错误但没有运气,但我认为在一些帮助下,这可能会起作用。

这是我需要它的工作方式...... 第 1 步:从下拉列表中选择客户名称。
第 2 步:从下拉列表中选择客户 ID,仅限于与第 1 步匹配的选项 第 3 步:从下拉列表中选择收货人名称,仅限于与步骤 2 匹配的选择 第 4 步:从下拉列表中选择收货人 ID,仅限于与第 3

步匹配的选择

保存客户数据的工作表标题为:“客户”。

客户和最终用户有时是一样的。他们的姓名列在第 1 列中,他们的 ID 列在第 2 列中。我需要在一个单独的较小级联中跟踪最终用户。 步骤1:从下拉列表中选择最终用户名称。
第 2 步:从下拉列表中选择最终用户 ID,仅限于与第 1 步匹配的选择

如果我打开用户表单>并单击列表框中的订单之一,我会收到一条错误消息。

Private Sub cboCustID_Change()
    cboSTName.Clear
    cboSTID.Clear
        If cboCustID.ListIndex < 0 Then Exit Sub
        cboSTName.List = oDic(cboCustID.Text) 'Cascade for cboSTName is dependent upon cboCustID 'Run-time error 381: Could not set List property. Invalid property array index.
        cboSTName.Enabled = cboSTName.ListCount > 1
        cboSTName.ListIndex = 0
        cboSTName.Text = "***SELECT SHIP TO NAME***"

如果我打开用户窗>转到“客户”选项卡并尝试选择客户名称。我在同一行代码上遇到相同的错误。

如果我打开用户窗>转到“客户”选项卡,则跳过选择客户名称,然后选择最终用户名称。那个较小的级联工作得很好。

我很乐意附上文件,但我不认为这是一种选择。所以,这里是与级联组合框相关的所有代码......

 Dim oDic As Object '***Cascading comboboxes. oDIC is a module global Object variable.
 'Since the Object will be used within several procedures (Initialize, Change, Terminate)...the code is outside of all procedures
 Dim CommonButtons As Collection

Private Sub UserForm_Initialize()
'redacted unrelated code
'***Cascading comboboxes for Customer and Ship-To***
Const d = "¤" 'Declaring a constant, D = "currency sign (As String)" D is the delimiter used within Join & Split functions
    Dim V 'As Variant (array) which is the "Customers" worksheet data minus the header
    Dim r As Long 'number
    Dim c As String 'text
    Dim K As String 'text
        Set customerTable = Worksheets("Customers").ListObjects("tblCustomers") 'referencing the ListObject named "tblCustomers"
        V = customerTable.DataBodyRange.Columns("A:Z") 'DataBodyRange is just the table data, it excludes the header/total sections of the table
        Set oDic = CreateObject("Scripting.Dictionary")
            'Variable oDic created outside all procedures
            'CreateObject("Scripting.Dictionary") creates a Dictionary object, which can be any form of data stored in an array. Each item is associated with a unique key.
    For r = 1 To UBound(V) '1 to the highest subscript for the dimension of array "V"
            c = V(r, 2) 'text string = cboCustID (col 2)
            K = c & V(r, 18) 'K = cboCustID (col 2) & cboSTName (col 18)
        If oDic.Exists(V(r, 1)) Then
                'Cascading step 1: Customer Name (col 1) is selected cboName
            If oDic.Exists(c) Then
                    'Cascading step 2: Only the CustID(s) in (col 2) that exist and 'match' the Customer Name appear in the cboCustID
                If oDic.Exists(K) Then
                        'Cascading step 3: Only the STName(s) in (col 18) that exist and 'match' the Customer Name + CustID will appear in the combo box
                    oDic(K) = Split(Join(oDic(K), d) & d & V(r, 19), d)
                           'Cascading Step 4: Only the STID(s) in col 19 that exist and 'match' the Customer Name + CustID + STName will appear in the combo box
                              'Split(Join(cboSTName,"d") & ("d" & cboSTID,"d") "d" = delimiter
                Else
                    oDic(c) = Split(Join(oDic(c), d) & d & V(r, 18), d)
                             'Split(Join(cboCustID,"d","d",cboSTName,"d") "d" = delimiter
                    oDic.Add K, Array(V(r, 19)) 'adds cboCustID & cboSTName to array of cboSTID
                End If
            Else
                oDic(V(r, 1)) = Split(Join(oDic(V(r, 1)), d) & d & c, d)
                    'cboName = cboName,"d","d",cboCustID,"d"
                oDic.Add c, Array(V(r, 18)) 'cboCustID,cboSTName
                oDic.Add K, Array(V(r, 19)) 'cboCustID,cboSTName,cboSTID
            End If
        Else
            cboName.AddItem V(r, 1) 'adds a new key/item, i.e., cboName to the array
            oDic.Add V(r, 1), Array(c) 'adds a new key/item, i.e., cboName to array of cboCustID
            oDic.Add c, Array(V(r, 18)) 'adds a new key/item, i.e., cboCustID to array of cboSTName
            oDic.Add K, Array(V(r, 19)) 'adds a new key/item, i.e., cboSTName to array of cboSTID
        End If
    Next
        cboName.Enabled = cboName.ListCount > 1
        cboName.ListIndex = 0
        cboName.Text = "***SELECT CUSTOMER***"
        cboCustID.Text = ""
        Me.txtBT = ""
        Me.txtBTAddr1 = ""
        Me.txtBTAddr2 = ""
        Me.txtBTCity = ""
        Me.txtBTState = ""
        Me.txtBTZip = ""
        Me.txtBTCntry = ""

'***Cascading comboboxes for End User Name and End User ID***
Const f = "¤" 'Declaring a constant, f = "currency sign (As String)" f is the delimiter used within Join & Split functions
    Dim Va 'As Variant (array) which is the "Customers" worksheet data minus the header
    Dim q As Long 'number (formerly 'r')
    Dim e As String 'text (cboEUID) (formerly 'c')
    Dim L As String 'text (cboEUName & cboEUID)
        Set customerTable = Worksheets("Customers").ListObjects("tblCustomers") 'referencing the ListObject named "tblCustomers"
        Va = customerTable.DataBodyRange.Columns("A:Z") 'DataBodyRange is just the table data, it excludes the header/total sections of the table
        Set oDic = CreateObject("Scripting.Dictionary")
            'Variable oDic created outside all procedures
            'CreateObject("Scripting.Dictionary") creates a Dictionary object, which can be any form of data stored in an array. Each item is associated with a unique key.
    For q = 1 To UBound(V) '1 to the highest subscript for the dimension of array "Va"
        e = Va(q, 2) 'text string = cboEUID (col 2)
        If oDic.Exists(Va(q, 1)) Then
                'Cascading step 1: End User Name (col 1) is selected cboEUName
            If oDic.Exists(e) Then
                    'Cascading step 2: Only the EUID(s) in (col 2) that exist and 'match' the End User Name appear in the cboEUID
                oDic(Va(q, 1)) = Split(Join(oDic(Va(q, 1)), f) & f & e, f)
                    'cboEUName = cboEUName,"f","f",cboEUID,"f"
            End If
        Else
            cboEUName.AddItem Va(q, 1) 'adds a new key/item, i.e., cboEUName to the array
            oDic.Add Va(q, 1), Array(e) 'adds a new key/item, i.e., cboEUName to array of cboEUID
        End If
    Next
        cboEUName.Enabled = cboEUName.ListCount > 1
        cboEUName.ListIndex = 0
        cboEUName.Text = "***SELECT CUSTOMER***"
        cboEUID.Text = ""
        Me.txtEUAddr1 = ""
        Me.txtEUAddr2 = ""
        Me.txtEUCity = ""
        Me.txtEUState = ""
        Me.txtEUZip = ""
        Me.txtEUCntry = ""

End Sub

'***CASCADING COMBOBOXES STARTS HERE OUTSIDE OF INITIALIZATION****
'Cascading order: 1. cboName, 2. cboCustID, 3. cboSTName, 4. cboSTID
Private Sub cboName_Change()
    cboCustID.Clear
    cboSTName.Clear
    cboSTID.Clear
        If cboName.ListIndex < 0 Then Exit Sub
        cboCustID.List = oDic(cboName.Text) 'Cascade starts...+
        cboCustID.Enabled = cboCustID.ListCount > 1
        cboCustID.ListIndex = 0
        
'***Pop-up Warning Message for Specific Customers***
'redacted unrelated code
End Sub


Private Sub cboCustID_Change()
    cboSTName.Clear
    cboSTID.Clear
        If cboCustID.ListIndex < 0 Then Exit Sub
        cboSTName.List = oDic(cboCustID.Text) 'Cascade for cboSTName is dependent upon cboCustID 'Run-time error 381: Could not set List property. Invalid property array index.
        cboSTName.Enabled = cboSTName.ListCount > 1
        cboSTName.ListIndex = 0
        cboSTName.Text = "***SELECT SHIP TO NAME***"

'Populates the Customer Address information based on the Customer ID that is selected
    Dim i As Long, LastRow As Long, wsh As Worksheet
    Set wsh = Sheets("CUSTOMERS") '"Set" sets an object reference vs to assigning a value
    LastRow = wsh.Range("B" & Rows.Count).End(xlUp).Row
        For i = 2 To LastRow 'Loop
            If Val(Me.cboCustID.Value) = wsh.Cells(i, "B") Then
                Me.txtBT = wsh.Cells(i, "K").Value
                Me.txtBTAddr1 = wsh.Cells(i, "C").Value
                Me.txtBTAddr2 = wsh.Cells(i, "D").Value
                Me.txtBTCity = wsh.Cells(i, "E").Value
                Me.txtBTState = wsh.Cells(i, "F").Value
                Me.txtBTZip = wsh.Cells(i, "G").Value
                Me.txtBTCntry = wsh.Cells(i, "H").Value
                'Need to add txtDiamond, txtTE, txtCon1, txtEmail1, txtCon2, txtEmail2.
                Me.txtSTAddr1 = ""
                Me.txtSTAddr2 = ""
                Me.txtSTAddr3 = ""
                Me.txtSTCity = ""
                Me.txtSTState = ""
                Me.txtSTZip = ""
                Me.txtSTCntry = ""
            Else
                If Me.txtBT.Value = "" Then Me.txtBT.Value = "Same As Sold To"
            End If
    Next i
End Sub


Private Sub cboSTName_Change()
    cboSTID.Clear:  If cboSTName.ListIndex < 0 Then Exit Sub
    cboSTID.List = oDic(cboCustID.Text & cboSTName.Text)
    cboSTID.Enabled = cboSTID.ListCount > 1
    cboSTID.ListIndex = 0
End Sub

Private Sub UserForm_Terminate()
     oDic.RemoveAll:  Set oDic = Nothing
End Sub


Private Sub cboSTID_Change()
'Populates the Ship To Address Information based on the Customer ID AND Ship To ID selected
Dim i As Long, LastRow As Long, wsh As Worksheet
Set wsh = Sheets("CUSTOMERS")
LastRow = wsh.Range("S" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
    If Val(Me.cboCustID.Value) = wsh.Cells(i, "B") And Val(Me.cboSTID.Value) = wsh.Cells(i, "S") Then
    Me.txtSTAddr1 = wsh.Cells(i, "T").Value
    Me.txtSTAddr2 = wsh.Cells(i, "U").Value
    Me.txtSTCity = wsh.Cells(i, "W").Value
    Me.txtSTState = wsh.Cells(i, "X").Value
    Me.txtSTZip = wsh.Cells(i, "Y").Value
    Me.txtSTCntry = wsh.Cells(i, "Z").Value
    End If
    Next i
End Sub


'***Cascading ComboBoxes for End User Information***
Private Sub cboEUName_Change()
    Dim e, U As Long
    Dim Rg(2) As Range
        cboEUID.Clear
        If cboEUName.ListIndex < 0 Then Exit Sub
            With Sheets("CUSTOMERS").ListObjects(1).Range.Columns(1)
                Set Rg(2) = .Parent.Range(.Find(cboEUName.Text, , xlValues, 1, , 1)(1, 2), .Find(cboEUName.Text, , xlValues, 1, , 2)(1, 2)) 'Run-Time error 91: object variable or with block variable not set
            End With
        e = Rg(2)
        If IsArray(e) Then
            cboEUID.AddItem e(1, 1)
        For U = 2 To UBound(e)
            If e(U, 1) <> e(U - 1, 1) Then cboEUID.AddItem e(U, 1)
        Next
    Else
        cboEUID.AddItem e
    End If
        cboEUID.ListIndex = cboEUID.ListCount > 1
End Sub
Private Sub cboEUID_Change()
'Populates the End User Address Information based on the End User ID. End User information is the same as the Customer information.
Dim i As Long, LastRow As Long, wsh As Worksheet
Set wsh = Sheets("CUSTOMERS")
LastRow = wsh.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
    If Val(Me.cboEUID.Value) = wsh.Cells(i, "B") Then
    Me.txtEUAddr1 = wsh.Cells(i, "C").Value
    Me.txtEUAddr2 = wsh.Cells(i, "D").Value
    Me.txtEUCity = wsh.Cells(i, "E").Value
    Me.txtEUState = wsh.Cells(i, "F").Value
    Me.txtEUZip = wsh.Cells(i, "G").Value
    Me.txtEUCntry = wsh.Cells(i, "H").Value
    End If
    Next i

End Sub

如果您愿意帮助我,请尽可能添加/编辑代码中的注释。它帮助我学习。先谢谢你。

Excel VBA ComboBox 用户窗体 级联

评论

0赞 Yodelayheewho 10/10/2023
只是检查一下,看看是否有人会帮助我。

答: 暂无答案