[已解决]求函数公式

yhyb

附件已上传，请各位老师帮忙。谢谢！！！

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-6-23 16:18

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Column <> 6 Then Exit Sub
   
4. Dim rng As Range
   
5. Application.EnableEvents = False
   
6. Set rng = Columns("b:c").Find(Target.Value, lookat:=xlWhole)
   
7. If Not rng Is Nothing Then Target = Cells(rng.Row, 3) Else Target = "None"
   
8. Application.EnableEvents = True
   
9. End Sub

复制代码

跳转到最佳答案楼层

zyouong

函数达不到的，用VBA，到VBA版块转转吧。

苏子龙

附件没有啊！

yhyb

苏子龙 发表于 2017-6-23 14:07
附件没有啊！

不好意思，我重传了

苏子龙

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Or Target.Column <> 6 Then Exit Sub
   
3.     Dim arr, i%
   
4.     Application.EnableEvents = False
   
5.     arr = Range("b2", Cells(Rows.Count, 3).End(3))
   
6.     For i = LBound(arr) To UBound(arr)
   
7.         If arr(i, 1) = Target.Value Then Target.Value = arr(i, 2): GoTo 100
   
8.         If arr(i, 2) = Target.Value Then GoTo 100
   
9.     Next
   
10.     Target.Value = Target.Value & "无"
    
11. 100:
    
12.     Application.EnableEvents = True
    
13. End Sub

复制代码

大灰狼1976

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Column <> 6 Then Exit Sub
   
4. Dim rng As Range
   
5. Application.EnableEvents = False
   
6. Set rng = Columns("b:c").Find(Target.Value, lookat:=xlWhole)
   
7. If Not rng Is Nothing Then Target = Cells(rng.Row, 3) Else Target = "None"
   
8. Application.EnableEvents = True
   
9. End Sub

复制代码

yhyb

苏子龙 发表于 2017-6-23 15:21

你好老师，你做的VBA可以解决这个问题，只是一点在输错时能不能显示为空，另外假如我原表在book112里，我要的答案在book113的A列里时，见附件代码又要怎么写。谢谢老师！！

苏子龙

yhyb 发表于 2017-6-25 10:49
你好老师，你做的VBA可以解决这个问题，只是一点在输错时能不能显示为空，另外假如我原表在book112里，我 ...

用6楼的第7行代码中Target = "None"，改成Target = ""。