[已解决]求助：动态下拉菜单

liuxingyi88

下拉菜单.rar (9.37 KB, 下载次数: 18)

2012-1-5 21:08 上传

点击文件名下载附件 求在主页工作表C3单元格，作为下拉菜单，以求出数据库D列的不重复的下拉菜单，现在想能否在C3单元格还能输入数据库D列没有的值。就是说在C3单元格取消限制，可随意输入任何值。谢了！

最佳答案

月排行榜 / 总排行榜

snrvgbb

2012-1-5 21:42

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim c As Range
   
3. If Target.Address = "$C$3" Then
   
4.     With Sheets("数据库")
   
5.         Set c = .Range("d:d").Find(Target, , , 1)
   
6.         If c Is Nothing Then
   
7.             .Range("d65536").End(3).Offset(1) = Target
   
8.         End If
   
9.     End With
   
10. End If
    
11. End Sub
    
12. 
    
13. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
14.     Dim arr
    
15.     Dim dic
    
16.     Set dic = CreateObject("scripting.dictionary")
    
17.     If Target.Address = "$C$4" Then
    
18.         With Sheets("数据库")
    
19.             arr = .Range("D1:D" & .Range("d65536").End(xlUp).Row)
    
20.             For i = 1 To UBound(arr)
    
21.                 dic(arr(i, 1)) = ""
    
22.             Next
    
23.         End With
    
24.         arrstr = Join(dic.keys, ",")
    
25.         With Sheet1.Range("C3").Validation
    
26.             .Delete
    
27.             .Add Type:=xlValidateList, Formula1:=arrstr
    
28.             .IgnoreBlank = True
    
29.             .ShowError = False
    
30.         End With
    
31.     End If
    
32. End Sub

复制代码

跳转到最佳答案楼层

sunjing-zxl

不懂你到底什么意思，又没有附件
你要取消下拉菜单，直接取消就行了。

snrvgbb

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim c As Range
   
3. If Target.Address = "$C$3" Then
   
4.     With Sheets("数据库")
   
5.         Set c = .Range("d:d").Find(Target, , , 1)
   
6.         If c Is Nothing Then
   
7.             .Range("d65536").End(3).Offset(1) = Target
   
8.         End If
   
9.     End With
   
10. End If
    
11. End Sub
    
12. 
    
13. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
14.     Dim arr
    
15.     Dim dic
    
16.     Set dic = CreateObject("scripting.dictionary")
    
17.     If Target.Address = "$C$4" Then
    
18.         With Sheets("数据库")
    
19.             arr = .Range("D1:D" & .Range("d65536").End(xlUp).Row)
    
20.             For i = 1 To UBound(arr)
    
21.                 dic(arr(i, 1)) = ""
    
22.             Next
    
23.         End With
    
24.         arrstr = Join(dic.keys, ",")
    
25.         With Sheet1.Range("C3").Validation
    
26.             .Delete
    
27.             .Add Type:=xlValidateList, Formula1:=arrstr
    
28.             .IgnoreBlank = True
    
29.             .ShowError = False
    
30.         End With
    
31.     End If
    
32. End Sub

复制代码

liuxingyi88

谢谢，辛苦了！！！！

liuxingyi88

snrvgbb 发表于 2012-1-5 21:42

2012工时统计.rar (99.64 KB, 下载次数: 7)

2012-1-7 08:56 上传

点击文件名下载附件 ，这里有不少的问题，老师费心了！！