关于用代码代替vlookup函数的请教

hwchai

请教一下，在sheet1有下面的原始数据，要想在sheet2不用vookup函数，如何用代码实现在A1输入 AAA时候， B1可以自动填写响应的描述"zhengzongliangcha" （只是举例，我不是王老吉厂家的，广告听多了），C1可以出现下拉菜单供选择 “111”，和"222", 谢谢

PN	Supplier	Description
AAA	111	zhengzongliangcha
BBB	4444	meiyongde
CCC	6666	Wanglaoji
DDD	8888	Coushude
AAA	222	zhengzongliangcha
DDD	9999	Coushude
CCC	332211	Wanglaoji

万分感谢

first236108

1. 
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     If Target.Column <> 1 Then
   
4.         Exit Sub
   
5.     End If
   
6.     Set aa = Sheets(1).Columns("A").Find(Target)
   
7.     If aa Is Nothing Then
   
8.         Exit Sub
   
9.     End If
   
10.     Target.Offset(, 1) = aa.Offset(0, 2)
    
11.     With Target.Offset(0, 2).Validation
    
12.         .Delete
    
13.         .Add Type:=xlValidateList, Formula1:="111,222"
    
14.     End With
    
15. End Sub
    
16. 
    

复制代码

附件请测试： 工作簿1.zip (14.09 KB, 下载次数: 243)

2014-10-11 21:35 上传

点击文件名下载附件

hwchai

first236108 发表于 2014-10-11 21:35
附件请测试：

代码倒数第三行的 formular1:="111,222",所以 C列的下拉菜单就只有这两个选项了。因为在实际的数据库中，supplier的名称长度各不一样，有的叫TTI, 有的是OPC (TTM)等

coby001

1. 
   
2. 
   
3. ' sheet2  的  Worksheet_Change 事件
   
4. 
   
5. Private Sub Worksheet_Change(ByVal Target As Range)
   
6.     Dim r As Range, sFirstAdds$
   
7.     On Error GoTo ErrHld:
   
8.     Application.EnableEvents = False
   
9.     Do
   
10.         If Target.Column <> 1 Then Exit Do
    
11.         With Sheet1.Range("A1").CurrentRegion
    
12.             Set r = .Columns(1).Find(Target.Value)
    
13.             If Not r Is Nothing Then
    
14.                 sFirstAdds = r.Address
    
15.                 Target(1, 3).Validation.Delete
    
16.                 Target(1, 3).Validation.Add Type:=xlValidateList, Formula1:=r(1, 2).Value
    
17.                 Target(1, 2) = r(1, 3)
    
18.                 Do
    
19.                     Set r = .Columns(1).FindNext(r)
    
20.                     If r.Address <> sFirstAdds Then
    
21.                         With Target(1, 3).Validation
    
22.                             .Modify Formula1:=.Formula1 & "," & r(1, 2).Value
    
23.                         End With
    
24.                     End If
    
25.                 Loop Until r Is Nothing Or r.Address = sFirstAdds
    
26.             End If
    
27.         End With
    
28.     Loop Until True
    
29. 
    
30. ErrHld:
    
31.     Application.EnableEvents = True
    
32. End Sub
    

复制代码

楼主试一下。
sheet1 的 A1 开始放数据

sheet2 的 A列 输入

hwchai

coby001 发表于 2014-10-12 11:43
楼主试一下。
sheet1 的 A1 开始放数据

Coby, Fantastic! 你给有类似问题的提供了正确的解！ 感谢你

coby001

hwchai 发表于 2014-10-12 11:59
Coby, Fantastic! 你给有类似问题的提供了正确的解！ 感谢你

如果解决了你的问题，就给朵花吧~
：D

hwchai

coby001 发表于 2014-10-12 12:09
如果解决了你的问题，就给朵花吧~
：D

我非常愿意这样做，但搜了一下百度好像我的积分还达不到这个送鲜花的级别。我会努力的，记着你这朵花的！

first236108

hwchai 发表于 2014-10-12 10:23
代码倒数第三行的 formular1:="111,222",所以 C列的下拉菜单就只有这两个选项了。因为在实际的数据库中， ...

你把他改成        .Add Type:=xlValidateList, Formula1:="=Sheet1!$B$2:$B$65535"
就OK了。想要增加什么，自己可以随意！~

hwchai

first236108 发表于 2014-10-12 12:23
你把他改成        .Add Type:=xlValidateList, Formula1:="=Sheet1!$B$2:$B$65535"
就OK了。想要增加什 ...

这样做会让sheet1 A列与B列的对应不再，(例如CCC,只对应 6666和332211，但这样会出现所有的对应) 取而代之的是B列的所有，如果庞大的数据库，会让选择的人很辛苦。

hwchai

coby001 发表于 2014-10-12 12:09
如果解决了你的问题，就给朵花吧~
：D

你再回复一次我，我就可以评分了。  happy!