【69期】根据关键字设置数据有效性

井沿蛙

太棒了……答案能直接引用，对于像我这样的低手太有用，拿过来就用。谢谢组织都都 答题者。

sunhua630

套用了，公式却显示出来，不知道哪里出错了

mkm-_7605

zhangjimfu 发表于 2011-1-3 15:47
操作步骤：

1、在点菜单B3:B17找到需要查找的值，放到固定位置I2。

牛啊 我正在找这个东西 太感谢了

418775812

这个一模一样的功能如何用VBA实现

kepobx41

首先感谢版主！我现在拿这个用于筛选预定信息，但是只能选前1000行，请问怎么筛选更多行呢？？？谢谢

活在理想的世界

VBA版本的只能先按ENTER键或者TAB键才能筛选，直接弄无法找到焦点，我试了许多次发现没有事件支持，不知楼主是否有办法？

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Call DD
   
3. Dim arr(), crr()
   
4. k = Sheet1.Range("a1048576").End(3).Row - 1
   
5. arr = Sheet1.Range("a2").Resize(k, 2)
   
6. For i = 1 To UBound(arr)
   
7.     If InStr(arr(i, 1), Me.Range("b" & Target.Row)) > 0 Then
   
8.         j = j + 1
   
9.         ReDim Preserve crr(1 To j)
   
10.         crr(j) = arr(i, 1)
    
11.     End If
    
12. Next
    
13. Sheet2.Range("b" & Target.Row).Validation.Delete
    
14. Sheet2.Range("b" & Target.Row).Validation.Add Type:=xlValidateList, Formula1:=Join(crr, ",")
    
15. Sheet2.Range("b" & Target.Row).Validation.ShowError = False
    
16. End Sub
    
17. Sub DD()
    
18. Dim arr(), crr()
    
19. k = Sheet1.Range("a1048576").End(3).Row - 1
    
20. arr = Sheet1.Range("a2").Resize(k, 2)
    
21. ReDim crr(1 To k)
    
22. For i = 1 To UBound(arr)
    
23.     crr(i) = arr(i, 1)
    
24. Next
    
25. On Error Resume Next
    
26. Sheet2.Range("b3").Resize(15, 1).Validation.Delete
    
27. Sheet2.Range("b3").Resize(15, 1).Validation.Add Type:=xlValidateList, Formula1:=Join(crr, ",")
    
28. Sheet2.Range("b3").Resize(15, 1).Validation.ShowError = False
    
29. End Sub

复制代码

02761752696

谢谢    分享

yzcg

7年的老帖，历久弥新。

Effing

大神你好，我参照@gdfcx的步骤实现了我要求的功能，但是由于我的数据库里的产品是英文表示的，好像不能区分大小写，不知道这一点能不能改进？

Effing

@gdfcx ，大神你好，我看了您的步骤再针对我的要求做了改进，改的只有一个函数，但是效果却更改了，我觉得我的改进可以实现英文字母大小写区分的问题，个人觉得也是很有价值的，希望楼主大神看在我实现了这个功能的基础上给我加一下分，给我一下动力，谢谢大神。
具体的改变在这里：=INDEX(A:A,SMALL(IF(ISNUMBER(SEARCH(INDIRECT(CELL("address")),A$2:A$86)),ROW($2:$86),4^8),ROW(A1)))&""
我把其中的find改成了search。
我看到网上有很多的人在问怎么实现英文大小写区分的问题，我想我的这个公式应该是已经实现了，而且不是通过vba实现的。