数据有效性VBA问题

jylai

数据来源B2:BX , 不含空白及文字invalid

D2 如何做数据有效性下拉选择

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()        '//2024.2.29
   
2.     Dim arr()
   
3.     arr = Range("b2:b" & Cells(Rows.Count, "b").End(xlUp).Row)
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     For i = 1 To UBound(arr)
   
6.         s = arr(i, 1)
   
7.         If s <> Empty And InStr(s, "invalid") = 0 Then
   
8.             d(s) = ""
   
9.         End If
   
10.     Next
    
11.     With Range("d2").Validation
    
12.         .Delete
    
13.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    
14.         .ShowError = False
    
15.     End With
    
16. End Sub

复制代码

gwjkkkkk

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ar, br(), i&, r&
   
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$D$2" Then Exit Sub
   
    ar = Range("B2", Cells(Rows.Count, "B").End(xlUp)).Value
    For i = 1 To UBound(ar)
        If Len(ar(i, 1)) Then
            If InStr(ar(i, 1), "invalid") = False Then
                 r = r + 1
                 ReDim Preserve br(1 To r)
                 br(r) = ar(i, 1)
            End If
        End If
    Next i
   
    With Target.Validation
        .Delete
       .Add xlValidateList, xlValidAlertStop, xlEqual, Join(br, ",")
    End With
End Sub

jylai

老师您太牛了，今天鲜花没有了，下回给您！感谢您

gwjkkkkk

利用SelectionChange事件，请参考。。。

jylai

gwjkkkkk 发表于 2024-2-29 19:07
利用SelectionChange事件，请参考。。。

老师您太牛了，今天鲜花没有了，下回给您！感谢您