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

liuxingyi88

求助2012工时统计.rar (144.5 KB, 下载次数: 8)

2012-1-15 10:00 上传

点击文件名下载附件

我做了个辅助的单元格，让c3的值等于c2,录入后就存到数据库里了。 如果数据库中没有需要的设备，就直接在C3里输入，就存到数据库中了。这样在C2单元格下拉菜单里就应该刚才输入的设备名称，不知为什么？请指教！谢谢！！

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2012-1-15 10:29

1. 
   
2. 
   
3. Sub 下拉菜单()
   
4.     Dim arr
   
5.     Dim i As Long, str As String
   
6.     Dim d As New dictionary
   
7.     With Sheets("数据库")
   
8.         arr = .Range("D1:D" & .[D65536].End(xlUp).row)
   
9.     End With
   
10.     For i = 1 To UBound(arr)
    
11.         d(arr(i, 1)) = d(arr(i, 1)) + 1
    
12.     Next i
    
13.     arr = d.Keys()
    
14.     str = Join(arr, ",")
    
15.     With Sheets("录入数据").Range("C2").Validation
    
16.         .Delete
    
17.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
18.                                                                            xlBetween, Formula1:=str   
    
19.     End With
    
20.     Set d = Nothing
    
21. End Sub
    
22. '这段代码放到模块里面

复制代码

1. Private Sub Worksheet_Change(ByVal Target As Range)    '自动添加日期
   
2.     If Target.Column = 4 Then
   
3.         Call 下拉菜单
   
4.     End If
   
5.     If Target.Column = 4 Then
   
6.         Target.Offset(, -3) = VBA.Year(Date)
   
7.         Target.Offset(, -2) = VBA.Month(Date)
   
8.         Target.Offset(, -1) = VBA.Day(Date)
   
9.     End If
   
10. End Sub
    
11. '上面这个在你原有代码里面加三句代码

复制代码

附件： 求助2012工时统计-sunjing.rar (146.03 KB, 下载次数: 33)

2012-1-15 10:33 上传

点击文件名下载附件

跳转到最佳答案楼层

sunjing-zxl

不太明白你的意识

liuxingyi88

sunjing-zxl 发表于 2012-1-15 10:05
不太明白你的意识

就是让C2的下拉菜单里有数据库d列的唯一设备的名称。

sunjing-zxl

1. 
   
2. 
   
3. Sub 下拉菜单()
   
4.     Dim arr
   
5.     Dim i As Long, str As String
   
6.     Dim d As New dictionary
   
7.     With Sheets("数据库")
   
8.         arr = .Range("D1:D" & .[D65536].End(xlUp).row)
   
9.     End With
   
10.     For i = 1 To UBound(arr)
    
11.         d(arr(i, 1)) = d(arr(i, 1)) + 1
    
12.     Next i
    
13.     arr = d.Keys()
    
14.     str = Join(arr, ",")
    
15.     With Sheets("录入数据").Range("C2").Validation
    
16.         .Delete
    
17.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
18.                                                                            xlBetween, Formula1:=str   
    
19.     End With
    
20.     Set d = Nothing
    
21. End Sub
    
22. '这段代码放到模块里面

复制代码

1. Private Sub Worksheet_Change(ByVal Target As Range)    '自动添加日期
   
2.     If Target.Column = 4 Then
   
3.         Call 下拉菜单
   
4.     End If
   
5.     If Target.Column = 4 Then
   
6.         Target.Offset(, -3) = VBA.Year(Date)
   
7.         Target.Offset(, -2) = VBA.Month(Date)
   
8.         Target.Offset(, -1) = VBA.Day(Date)
   
9.     End If
   
10. End Sub
    
11. '上面这个在你原有代码里面加三句代码

复制代码

附件： 求助2012工时统计-sunjing.rar (146.03 KB, 下载次数: 33)

2012-1-15 10:33 上传

点击文件名下载附件

liuxingyi88

sunjing-zxl 发表于 2012-1-15 10:29
附件：

谢谢了！忠心的感谢，辛苦啊！！！