[已解决]求助如何在数据中提取不重复单位名称做数据有效性

qinhuan66

求助黄色单元格如何在数据中提取不重复单位名称做数据有效性
求助.rar (28.47 KB, 下载次数: 20)

2014-2-27 17:42 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

xdragon

2014-2-27 19:08

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.   If Target.Address = "$D$1" Then
   
3.     Dim cnn As Object, SQL$
   
4.     Dim str$
   
5.     Set cnn = CreateObject("adodb.connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.    
   
8.     Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
   
9.     Case Is <= 11
   
10.         cnn.Open = "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\data.mdb;Jet OLEDB:Database Password=695360052"
    
11.     Case Is >= 12
    
12.         cnn.Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\data.mdb;Jet OLEDB:Database Password=695360052"
    
13.     End Select
    
14.     SQL = "select distinct 单位名称 from 信息汇总"
    
15.     Rst.Open SQL, cnn, 1, 3
    
16.     Do While Not Rst.EOF
    
17.        str = str & "," & Rst.fields(0)
    
18.        Rst.movenext
    
19.     Loop
    
20.     With Target.Validation
    
21.         .Delete
    
22.         .Add Type:=xlValidateList, Formula1:=Mid(str, 2)
    
23.     End With
    
24.     cnn.Close
    
25.     Set cnn = Nothing
    
26.   End If
    
27. End Sub
    

复制代码

你这个单位只有一个啊。。。。

跳转到最佳答案楼层

xdragon

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.   If Target.Address = "$D$1" Then
   
3.     Dim cnn As Object, SQL$
   
4.     Dim str$
   
5.     Set cnn = CreateObject("adodb.connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.    
   
8.     Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
   
9.     Case Is <= 11
   
10.         cnn.Open = "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\data.mdb;Jet OLEDB:Database Password=695360052"
    
11.     Case Is >= 12
    
12.         cnn.Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\data.mdb;Jet OLEDB:Database Password=695360052"
    
13.     End Select
    
14.     SQL = "select distinct 单位名称 from 信息汇总"
    
15.     Rst.Open SQL, cnn, 1, 3
    
16.     Do While Not Rst.EOF
    
17.        str = str & "," & Rst.fields(0)
    
18.        Rst.movenext
    
19.     Loop
    
20.     With Target.Validation
    
21.         .Delete
    
22.         .Add Type:=xlValidateList, Formula1:=Mid(str, 2)
    
23.     End With
    
24.     cnn.Close
    
25.     Set cnn = Nothing
    
26.   End If
    
27. End Sub
    

复制代码

你这个单位只有一个啊。。。。