已知两个条件，做对应的下拉菜单，求大神帮忙！

wm863636363

miaojohn45 发表于 2024-3-29 15:51
好像是牵涉到数组计算了，之前的确实用不了，用辅助列完成吧：

方法二不太好用，这样行不行？现在A2和B2单元格我不需要做下拉，我就手动输入数据，当A2和B2单元格输入对应的数据后,C2才会出现对应的下拉菜单。相当于这张表上只做C2这个下拉菜单，A2和B2不做下拉

miaojohn45

wm863636363 发表于 2024-3-29 16:09
方法二不太好用，这样行不行？现在A2和B2单元格我不需要做下拉，我就手动输入数据，当A2和B2单元格输入对 ...

一样需要做出辅助序列。

miaojohn45

wm863636363 发表于 2024-3-29 16:09
方法二不太好用，这样行不行？现在A2和B2单元格我不需要做下拉，我就手动输入数据，当A2和B2单元格输入对 ...

如果你的软件支持lambda函数，可以定义一个双参数函数名称，然后在数据验证里引用：

wm863636363

山菊花 发表于 2024-3-29 14:41
供参考。
多级菜单（数据有效性）终极方案【VBA】
https://club.excelhome.net/thread-1510919-1-1.html
...

大佬，我用你的那个表格修改了，但是我需要的在FGHI列显示，不需要在ABCD列显示，麻烦帮忙修改一下
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nL%
    nL = Target.Column
    If Target.Row = 1 Or nL > 3 Or Target.CountLarge > 1 Then Exit Sub
    Application.EnableEvents = False
    Target.Offset(0, 1).Resize(1, 4 - nL).ClearContents
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sj(), nL%, cTxt$, nRow%, Arr(), ds As Object
    Set ds = CreateObject("Scripting.Dictionary")
    If Target.Row = 1 Or Target.Column > 4 Or Target.CountLarge > 1 Then Exit Sub
    nL = Target.Column
    sj = Range("a" & Target.Row).Resize(1, 3).Value
    With Sheets("基础")
        nRow = .Cells(999, nL).End(xlUp).Row
        Arr = .Range("a1").Resize(nRow, nL).Value
    End With
    For i = 2 To nRow
        For j = 1 To nL - 1
            If Arr(i, j) <> sj(1, j) Then Exit For
        Next
        If j = nL And Not ds.exists(Arr(i, nL)) Then
            ds(Arr(i, nL)) = ""
            cTxt = cTxt & "," & Arr(i, nL)
        End If
    Next
    With Target.Validation
        .Delete
        If cTxt <> "" Then .Add 3, 1, 1, Mid(cTxt, 2)
    End With
End Sub

wm863636363

山菊花 发表于 2024-3-29 14:41
供参考。
多级菜单（数据有效性）终极方案【VBA】
https://club.excelhome.net/thread-1510919-1-1.html
...

大佬，你的这个表怎么改？代码怎么写？

山菊花

wm863636363 发表于 2024-3-29 18:03
大佬，你的这个表怎么改？代码怎么写？

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nL%
    nL = Target.Column
    If Target.Row = 1 Or nL < 6 Or nL > 8 Or Target.CountLarge > 1 Then Exit Sub '修改9
    Application.EnableEvents = False
    Target.Offset(0, 1).Resize(1, 9 - nL).ClearContents '修改10
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sj(), nL%, cTxt$, nRow%, Arr(), ds As Object
    Set ds = CreateObject("Scripting.Dictionary")
    If Target.Row = 1 Or Target.Column < 6 Or Target.Column > 9 Or Target.CountLarge > 1 Then Exit Sub '修改1
    nL = Target.Column
    sj = Range("f" & Target.Row).Resize(1, 3).Value '修改2
    With Sheets("基础")
        nRow = .Cells(999, nL - 5).End(xlUp).Row '修改3
        Arr = .Range("a1").Resize(nRow, nL - 5).Value '修改4
    End With
    For i = 2 To nRow
        For j = 1 To nL - 6 '修改5
            If Arr(i, j) <> sj(1, j) Then Exit For
        Next
        If j = nL - 5 And Not ds.exists(Arr(i, nL - 5)) Then '修改6
            ds(Arr(i, nL - 5)) = "" '修改7
            cTxt = cTxt & "," & Arr(i, nL - 5) '修改8
        End If
    Next
    With Target.Validation
        .Delete
        If cTxt <> "" Then .Add 3, 1, 1, Mid(cTxt, 2)
    End With
End Sub

山菊花

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nL%
    nL = Target.Column
    If Target.Row = 1 Or nL < 6 Or nL > 8 Or Target.CountLarge > 1 Then Exit Sub '修改4
    Application.EnableEvents = False
    Target.Offset(0, 1).Resize(1, 9 - nL).ClearContents '修改5
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sj(), nL%, cTxt$, nRow%, Arr(), ds As Object
    Set ds = CreateObject("Scripting.Dictionary")
    nL = Target.Column - 5 '修改1
    If Target.Row = 1 Or nL < 1 Or nL > 4 Or Target.CountLarge > 1 Then Exit Sub '修改2
    sj = Range("f" & Target.Row).Resize(1, 3).Value '修改3
    With Sheets("基础")
        nRow = .Cells(999, nL).End(xlUp).Row
        Arr = .Range("a1").Resize(nRow, nL).Value
    End With
    For i = 2 To nRow
        For j = 1 To nL - 1
            If Arr(i, j) <> sj(1, j) Then Exit For
        Next
        If j = nL And Not ds.exists(Arr(i, nL)) Then
            ds(Arr(i, nL)) = ""
            cTxt = cTxt & "," & Arr(i, nL)
        End If
    Next
    With Target.Validation
        .Delete
        If cTxt <> "" Then .Add 3, 1, 1, Mid(cTxt, 2)
    End With
End Sub

wm863636363

山菊花 发表于 2024-3-29 18:23
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nL%
    nL = Target.Column

总是提示这个

山菊花

wm863636363 发表于 2024-3-29 18:31
总是提示这个

供参考。

wm863636363

山菊花 发表于 2024-3-29 18:48
供参考。

再帮我改一个从E列开始的，只显示EFG这三列下拉，然后“基础表”可以录入到9999行的，麻烦大佬了，跪谢！！