[已解决]如何用 vba代替公式vlookup

cpl275538

1、当B列和J列选择好产品名称后，自动填出相应编号，也就是VLOOKUP功能。
2、编号需要自动填入，不需要点击执行代码
3、求G列和O列代码
感谢！

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-7-20 09:10

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.      If Target.Count > 1 Then Exit Sub
   
3.      If Intersect(Target, [b3:b70]) Is Nothing And Intersect(Target, [j3:j70]) Is Nothing Then Exit Sub
   
4.      Dim rng As Range, sh&
   
5.      If Target.Column = 2 Then sh = 2 Else sh = 3
   
6.      Target.Offset(, 1).Resize(, 4).Validation.Delete
   
7.      Target.Offset(, 1).Resize(, 4).ClearContents
   
8.      Set rng = Sheets(sh).UsedRange.Find(Target, lookat:=xlWhole)
   
9.      If Not rng Is Nothing Then Target.Offset(, 5) = rng.Offset(, 4)
   
10. End Sub

复制代码

跳转到最佳答案楼层

王思聪

路过帮顶

大灰狼1976

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Column <> 3 And Target.Column <> 8 Then Exit Sub
   
4. If Target = "" Then Target.Offset(, 1).ClearContents: Exit Sub
   
5. Dim d As Object, i&, arr
   
6. Set d = CreateObject("scripting.dictionary")
   
7. arr = Sheets(-Int(-Target.Column / 2.9)).[b1].CurrentRegion
   
8. For i = 3 To UBound(arr)
   
9.   d(arr(i, 2)) = arr(i, 3)
   
10. Next i
    
11. Target.Offset(, 1) = d(Target.Value)
    
12. End Sub

复制代码

cpl275538

大灰狼1976 发表于 2017-7-19 16:25

感谢您再次又再次又再次出手帮助，但我VBA知识浅薄，您这次写的代码太深奥，连一般参数我都改不来了，所以我发一个实际情况的表给您看下，劳烦您再根据我的表修改下

cpl275538

大灰狼1976 发表于 2017-7-19 16:25

最好能把引用的Sheet2和Sheet5表体现在代码内，还有列的参数，这样我也容易根据实际情况稍作修改，代码生成的编号只在G2：G7和O2：O7感谢,其他地方, 如B7=“手机”，G7=“A001”,但B8=“手机”，则G8不体现，忽略

大灰狼1976

“但B8=“手机”，则G8不体现，忽略”，这是为什么，跟上一行相当的就不体现是吗？

cpl275538

大灰狼1976 发表于 2017-7-19 17:11
“但B8=“手机”，则G8不体现，忽略”，这是为什么，跟上一行相当的就不体现是吗？

您还记得昨天代码吗？B列有做下拉选项的b3:b70，J列下拉选项的J3:J70，所以我想生成对应的编号的也有范围

Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Count > 1 Then Exit Sub
     If Intersect(Target, [b3:b70]) Is Nothing Then Exit Sub
     Target.Offset(, 1).Resize(, 4).Validation.Delete
     Target.Offset(, 1).Resize(, 4).ClearContents
End Sub

cpl275538

大灰狼1976 发表于 2017-7-19 17:11
“但B8=“手机”，则G8不体现，忽略”，这是为什么，跟上一行相当的就不体现是吗？

我把原件发给您看下，G3：G70和O3：O70需要实现的“单位”自动填充，1至70行里面的代码都是您昨天帮我做好的，70行之后的我还有用处，里面可能有各种公式。所以不敢被代码替换掉，劳烦您有空看下是否能解决？

大灰狼1976

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.      If Target.Count > 1 Then Exit Sub
   
3.      If Intersect(Target, [b3:b70]) Is Nothing And Intersect(Target, [j3:j70]) Is Nothing Then Exit Sub
   
4.      Dim rng As Range, sh&
   
5.      If Target.Column = 2 Then sh = 2 Else sh = 3
   
6.      Target.Offset(, 1).Resize(, 4).Validation.Delete
   
7.      Target.Offset(, 1).Resize(, 4).ClearContents
   
8.      Set rng = Sheets(sh).UsedRange.Find(Target, lookat:=xlWhole)
   
9.      If Not rng Is Nothing Then Target.Offset(, 5) = rng.Offset(, 4)
   
10. End Sub

复制代码

cpl275538

大灰狼1976 发表于 2017-7-20 09:10

感谢，太感谢了，您真的帮了我太多次了