怎样使用VBA给单元格设置数据有效性下拉列表？

Fanrk

怎样使用VBA给单元格设置数据有效性下拉列表？

182197315

arr = Sheets("基础信息").Range("A2:B" & Sheets("基础信息").Range("B65536").End(xlUp).Row)
For i = 1 To UBound(arr)
    x = arr(i, 1): y = arr(i, 2)
    If Not d.Exists(x) Then Set d(x) = New Dictionary
    d(x)(y) = ""
Next
If Target.Column = 9 Then
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.Keys, ",")
    End With
    Target.Offset(0, 2) = ""
Else
    x = Target.Offset(0, -2).Value
    If d.Exists(x) Then
        t = d(x).Keys
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=IIf(UBound(t) <> -1, Join(t, ","), t)
        End With
    Else
        Target = ""
    End If
End If

Fanrk

182197315 发表于 2018-12-31 11:00
arr = Sheets("基础信息").Range("A2:B" & Sheets("基础信息").Range("B65536").End(xlUp).Row)
For i = 1 ...

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. arr = Sheets("基础信息").Range("A2:B" & Sheets("基础信息").Range("B65536").End(xlUp).Row)
   
3. For i = 1 To UBound(arr)
   
4.      x = arr(i, 1): y = arr(i, 2)
   
5.      If Not d.Exists(x) Then Set d(x) = New Dictionary
   
6.      d(x)(y) = ""
   
7. Next
   
8. If Target.Column = 9 Then
   
9.      With Target.Validation
   
10.          .Delete
    
11.          .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.Keys, ",")
    
12.      End With
    
13.      Target.Offset(0, 2) = ""
    
14. Else
    
15.      x = Target.Offset(0, -2).Value
    
16.      If d.Exists(x) Then
    
17.          t = d(x).Keys
    
18.          With Target.Validation
    
19.              .Delete
    
20.              .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=IIf(UBound(t) <> -1, Join(t, ","), t)
    
21.          End With
    
22.      Else
    
23.          Target = ""
    
24.      End If
    
25. End If
    
26. End Sub

复制代码

是这个样输入代码吗？为什么提示用户定义类型未定义呢？

liulang0808

楼主自己录制一段宏即可的。。。

Fanrk

liulang0808 发表于 2018-12-31 15:22
楼主自己录制一段宏即可的。。。

这个应该怎么录制？要走什么过程可以告知一下吗？谢谢了

liulang0808

Fanrk 发表于 2018-12-31 18:58
这个应该怎么录制？要走什么过程可以告知一下吗？谢谢了

楼主查询下录制宏的方法就知道了

182197315

楼主没有附件，没办法帮你

忘得快

182197315 发表于 2019-1-1 19:18
楼主没有附件，没办法帮你

怎样使用VBA给单元格设置数据有效性下拉列表.zip (15.77 KB, 下载次数: 241)

2019-1-1 23:31 上传

点击文件名下载附件

这附件可以吗？

182197315

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 And Target.Column <> 2 Then Exit Sub
Dim i%, arr, x$
Dim d As New Dictionary
arr = Sheets("基础信息").Range("A1:B" & Sheets("基础信息").Range("B65536").End(xlUp).Row)
For i = 1 To UBound(arr)
     x = arr(i, 1): y = arr(i, 2)
     If Not d.Exists(x) Then Set d(x) = New Dictionary
     d(x)(y) = ""
Next
If Target.Column = 1 Then
     With Target.Validation
         .Delete
         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.Keys, ",")
     End With
     Target.Offset(0, 1) = ""
Else
     x = Target.Offset(0, -1).Value
     If d.Exists(x) Then
         t = d(x).Keys
         With Target.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=IIf(UBound(t) <> -1, Join(t, ","), t)
         End With
     Else
         Target = ""
     End If
End If
End Sub

忘得快

182197315 发表于 2019-1-2 19:25
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If  ...

出错提示：用户定义类型未定义
请教  d As New Dictionary应引用什么控件？谢谢！