[已解决]上传附件了，请帮忙看看

278059169

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
    If Target.Column = 1 And Target.Row > 2 Then
        Application.EnableEvents = False
        Target.Offset(0, 1) = Sheets(2).Range("a:a").Find(Target, , , xlWhole).Offset(0, 1)
        Application.EnableEvents = True
    ElseIf Target.Column = 2 And Target.Row > 2 Then
        Application.EnableEvents = False
        Target.Offset(0, -1) = Sheets(2).Range("b:b").Find(Target, , , xlWhole).Offset(0, -1)
        Application.EnableEvents = True
    End If
End If
End Sub



表2的A列是数组000001      

          B列是名称比如平安银行

在表1的A或B列输入对应的数字或名字，就自动引用表2的对应项到表1的AB列

现在的问题是，随便在表1的A或B列输入错误值后，表格就再也不工作了，只能不保存退出重新打开

能不能输入错误后，提示“没有该股票，请核对后再输入”而后表格是正常工作的

最佳答案

月排行榜 / 总排行榜

wanao2008

2016-7-3 20:31

帮你改了一下代码：
测试通过！

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     On Error GoTo Err_Handle
   
3.     If Target.Count = 1 Then
   
4.         If Target.Column = 1 And Target.Row > 2 Then
   
5.             Application.EnableEvents = False
   
6.             Target.Offset(0, 1) = Sheets(2).Range("a:a").Find(Target, , , xlWhole).Offset(0, 1)
   
7.             Application.EnableEvents = True
   
8.         ElseIf Target.Column = 2 And Target.Row > 2 Then
   
9.             Application.EnableEvents = False
   
10.             Target.Offset(0, -1) = Sheets(2).Range("b:b").Find(Target, , , xlWhole).Offset(0, -1)
    
11.             Application.EnableEvents = True
    
12.         End If
    
13.     End If
    
14.     Exit Sub
    
15. Err_Handle:
    
16.                 Application.EnableEvents = True
    
17.                 MsgBox ("没有该股票，请核对后再输入")
    
18.                 Target = ""
    
19.                 Target.Select
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

278059169

大神们呢，我在等呢

278059169

上传附件了

278059169

顶起来

wanao2008

帮你改了一下代码：
测试通过！

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     On Error GoTo Err_Handle
   
3.     If Target.Count = 1 Then
   
4.         If Target.Column = 1 And Target.Row > 2 Then
   
5.             Application.EnableEvents = False
   
6.             Target.Offset(0, 1) = Sheets(2).Range("a:a").Find(Target, , , xlWhole).Offset(0, 1)
   
7.             Application.EnableEvents = True
   
8.         ElseIf Target.Column = 2 And Target.Row > 2 Then
   
9.             Application.EnableEvents = False
   
10.             Target.Offset(0, -1) = Sheets(2).Range("b:b").Find(Target, , , xlWhole).Offset(0, -1)
    
11.             Application.EnableEvents = True
    
12.         End If
    
13.     End If
    
14.     Exit Sub
    
15. Err_Handle:
    
16.                 Application.EnableEvents = True
    
17.                 MsgBox ("没有该股票，请核对后再输入")
    
18.                 Target = ""
    
19.                 Target.Select
    
20. End Sub
    

复制代码

278059169

wanao2008 发表于 2016-7-3 20:31
帮你改了一下代码：
测试通过！

非常感谢!!