Excel 列中的从属下拉列表

我需要什么
两列，一列在每行中有一个下拉列表，我可以在其中选择代码，另一列在每行中有一个下拉列表，它将根据该列表选择显示子代码

我拥有的
用VBA代码填充所有J列的代码：

Sub main()
Dim lCopyLastRow As Long
lCopyLastRow = Workbooks("Reports.xlsm").Worksheets("Data").Cells(Workbooks("Reports.xlsm").Worksheets("Data").Rows.Count, "AT").End(xlUp).Row

'replace "J2" with the cell you want to insert the drop down list
With Range("J2").Validation
    .Delete
    'replace "=A1:A6" with the range the data is in.
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
      Operator:=xlBetween, Formula1:="=Data!$AT$2:$AT$" & lCopyLastRow
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With
End Sub

当我尝试对dependent下拉列表执行相同操作时，我得到一个错误

Sub main2()
Dim lCopyLastRow As Long

'replace "J2" with the cell you want to insert the drop down list
With Range("K2").Validation
    .Delete
    'replace "=A1:A6" with the range the data is in.
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
      Operator:=xlBetween, Formula1:="=OFFSET(Data!$E$1,MATCH($J2,Data!$C$2:$C$6253,0),0,COUNTIF(Data!$C$2:$C$6253,$J2))"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With
End Sub

我知道问题出在公式上

---

如果解释得当，这项任务相当简单

以下是概念：
J-cell是列“J”中更改的单元格，K-cell是列“K”中与J-cell位于同一行的单元格。
1.打开工作簿时，将数据验证设置为“J”列
2.捕捉任何单个J细胞的每一次变化
3.根据J-cell的值生成验证列表
4.检查该列表是否已创建并具有值
5.将数据验证设置为K单元

解决方案：
确保概念#1-为打开的

工作簿

事件创建处理程序

这方面的代码是：

Private Sub Workbook_Open()

' Set data validation to column "J" (concept #1)
SetValidationToJ
End Sub

为

工作表\u Change

事件创建处理程序，确保选择正确的工作表和事件。

此事件处理程序的代码（请参阅注释）：

其余代码（2个子模块和1个函数）将放在常规模块中：

Option Explicit
Dim dataSht As Worksheet

Sub SetValidationToJ()
Dim lastRow As Long
Dim sourceRngJ As Range

If dataSht Is Nothing Then Set dataSht = ThisWorkbook.Sheets("Data")

With dataSht
    Set sourceRngJ = Range(.Cells(2, 46), .Cells(Rows.Count, 46).End(xlUp))
    lastRow = .Cells(Rows.Count, 46).End(xlUp).Row

    With Range(.Cells(2, 10), .Cells(lastRow, 10)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:="=" & sourceRngJ.Address
        .IgnoreBlank = True
        .InCellDropdown = True
        .ErrorTitle = "Error!"
        .ErrorMessage = "You must select from provided list!"
        .ShowError = True
    End With
End With

End Sub

Sub SetValidationToK(Values() As Variant, RowNum As Long)

If dataSht Is Nothing Then Set dataSht = ThisWorkbook.Sheets("Data")

With dataSht
    With .Cells(RowNum, 11).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:=Join(Values, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .ErrorTitle = "Error!"
        .ErrorMessage = "You must select from provided list!"
        .ShowError = True
    End With
End With

End Sub

Function GetValuesForKValidation(SrcRange As Range) As Variant
Dim r As Range, searchRange As Range
Dim output() As Variant
Dim i As Integer

If dataSht Is Nothing Then Set dataSht = ThisWorkbook.Sheets("Data")

With dataSht
    Set searchRange = Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp))
End With

For Each r In searchRange
    If r.Value = SrcRange.Value Then
        ReDim Preserve output(i)
            output(i) = r.Offset(0, 2).Value
            i = i + 1
    End If
Next

GetValuesForKValidation = output

End Function

---

非常感谢您的评论。

我在userform上创建了一个带有相关下拉列表的示例。我希望它对您有用。 数据库包括产品、产品类别、产品供应商和价格。即使表中的数据是混合的，我们也可以通过在链接的下拉列表中按类别和供应商对产品进行分组来轻松地检查产品，数据可以输入到其他表中

我在工作表上定义了名称并使用了Dictionary对象：

Private Sub UserForm_Initialize()
Dim k As Byte, x As Variant
Me.BackColor = 15658720
For k = 1 To 4
Controls("Frame" & k).BackColor = 15658720
Next
 Supplier = Application.Transpose(Range("Supplier"))
 Category = Application.Transpose(Range("Category"))
 Product = Application.Transpose(Range("Product"))
 Price = Application.Transpose(Range("Price"))
 Set ScDctnry = CreateObject("Scripting.Dictionary")
  For Each x In Supplier
      SD(x) = ""
 Next x
  ComboBox1.List = ScDctnry.keys
 End Sub

---

您是否尝试过对一行手动执行此操作？您会遇到什么样的错误？哪一行抛出了它？另外，看到使用过的数据样本会很好，因为我无法理解这个

=偏移量（data！$E$1，MATCH（$J2，data！$C$2:$C$6253,0），0，COUNTIF（data！$C$2:$C$6253，$J2））

@controlnetic.nomad如果我使用excel中的“验证”按钮对一行进行验证，我不会得到错误，但如果使用VBA，我会得到错误。@我得到这个错误：这是错误行：嗨，我对代码做了一些更改，但基本上你解决了我需要的问题，谢谢。

Private Sub UserForm_Initialize()
Dim k As Byte, x As Variant
Me.BackColor = 15658720
For k = 1 To 4
Controls("Frame" & k).BackColor = 15658720
Next
 Supplier = Application.Transpose(Range("Supplier"))
 Category = Application.Transpose(Range("Category"))
 Product = Application.Transpose(Range("Product"))
 Price = Application.Transpose(Range("Price"))
 Set ScDctnry = CreateObject("Scripting.Dictionary")
  For Each x In Supplier
      SD(x) = ""
 Next x
  ComboBox1.List = ScDctnry.keys
 End Sub