各位大神，多级下拉菜单各级怎么自动更新，去重，去除空白项

高盛玉

各位大神，多级下拉菜单各级怎么自动更新，去重，去除空白项

橒♂蝣

建议上传附件，具体问题具体分析

高盛玉

我不会上传EXCEL，只能上传压缩包，就是底稿里面的省份希望在分级查看的那个表里省的下拉菜单里面去除重复项显示，市会跟着省份联动，而且如果有新增项，省和市的下拉菜单都可以自动更新，两个下单菜单源数据如果有重复项的话都去重显示

我有一头小驴驴

我有个不是很完美的解决方案。
一、底稿工作表转为超级表，可实现后期新增数据自动更新；


二、省份数据验证构建辅助列=UNIQUE(表1[省])；

三、分级查看工作表中省下方单元格数据验证输入公式=OFFSET($D$1,1,,COUNTA(D:D)-1)；
四、分级查看工资表中市下方单元格数据验证输入公式=OFFSET(底稿!$B$1,MATCH(A2,底稿!A:A,0),0,COUNTIF(底稿!A:A,A2))。
详见附件。

高盛玉

我的EXCEL没有UNIQUE，我用的INDEX(MATCH(,COUNTIF(),))&""的数据组，电脑就变得超级卡

高盛玉

辛苦大神再帮忙看下，我的二级下拉菜单联动的时候串行了，是我哪个公式不对啊

高盛玉

我发现我上传的压缩文件里面公式和数据验证都没有了，我单独打公式也发不出去；我用的图中的公式，请各位大神帮忙看下问题出在哪里，为什么会串行

1121228509

启用宏:



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim hh As Long, lh As Long, fk As Long, xh As Long
Dim dic As Object
Dim Arr As Variant
Dim sf As String
On Error Resume Next
Application.EnableEvents = False
hh = Target.Row
If Selection.Cells.CountLarge = 1 And hh > 1 Then
    Set dic = CreateObject("Scripting.Dictionary")
    lh = Target.Column
    fk = Sheets("底稿").Cells(Rows.Count, 1).End(xlUp).Row
    Arr = Sheets("底稿").Range("A1").Resize(fk, 2)
    If lh = 1 Then
        For xh = 2 To fk
            If (Not dic.Exists(Arr(xh, 1) & "")) And Arr(xh, 1) <> "" Then dic.Add Arr(xh, 1), ""
         Next xh
    Else
        If lh = 2 And hh <= fk And Len(Cells(hh, 1)) <> 0 Then
            sf = Cells(hh, 1)
            For xh = 2 To fk
                If (Not dic.Exists(Arr(xh, 2) & "")) And Arr(xh, 2) <> "" And Arr(xh, 1) = sf Then dic.Add Arr(xh, 2), ""
             Next xh
        End If
    End If
'    Unprotect Password:="111" '取消分级查看表的保护密码111
    If dic.Count <> 0 Then
        Range("A:B").Validation.Delete
        Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(dic.Keys, ",")
        Target.Validation.IgnoreBlank = True
        Target.Validation.InCellDropdown = True
        Target.Validation.ErrorTitle = "无效的列外名称"
        Target.Validation.ErrorMessage = "不允许输入列外名称"
        Target.Validation.IMEMode = xlIMEModeNoControl
        Target.Validation.ShowInput = False
        Target.Validation.ShowError = True
    End If
End If
'Protect Password:="111", userinterfaceonly:=True '保护分级查看表的保护密码111
'EnableSelection = xlNoRestrictions '保护分级查看表锁定未锁定单元格
Set dic = Nothing
Set Arr = Nothing
Application.EnableEvents = True
End Sub

新建 Microsoft Excel 工作表.rar (18.64 KB, 下载次数: 2)

2023-5-26 19:39 上传

点击文件名下载附件

高盛玉

我看不懂这个代码，这个代码是针对一级和二级都自动更新且自动去除重复项的吗

1121228509

是的，自动更新，自动去重复，自动设置有效性序列，也就是不需要预先做好有效性序列，鼠标单击单元格自动完成有效性序列。