提问人:Yodelayheewho 提问时间:10/6/2023 更新时间:10/6/2023 访问量:26
在级联组合框上出现错误
Getting errors on cascading comboboxes
问:
非常缺乏经验,并找到了级联组合框的代码。我尝试解决错误但没有运气,但我认为在一些帮助下,这可能会起作用。
这是我需要它的工作方式......
第 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
如果您愿意帮助我,请尽可能添加/编辑代码中的注释。它帮助我学习。先谢谢你。
答: 暂无答案
评论