求高手指点, 看看红色内容的这段代码为什么无法在附件中执行, 谢谢!

419837499

我调试了好多次，但真的找不出究竟是哪里的问题，请高手帮忙看看啊，多谢啦！

419837499

究竟是为什么不能运行呢???真头痛!

蓝桥玄霜

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. Application.EnableEvents = False
   
4. Dim Arr, x&, i&, c
   
5. With Sheet1
   
6.     Arr = .UsedRange
   
7. End With
   
8. If Target.Column = 6 Then
   
9.     Target = LCase(Target.Value)
   
10.     For i = 2 To UBound(Arr)
    
11.         If Target = Arr(i, 2) Then Target = Arr(i, 3): Exit Sub
    
12.     Next i
    
13. ElseIf Target.Column = 5 Then
    
14.     For i = 2 To UBound(Arr)
    
15.         If Target = Arr(i, 5) Then Target = Arr(i, 6): Exit Sub
    
16.     Next i
    
17.     x = Sheet1.Range("f" & Cells.Rows.Count).End(3).Row
    
18.     Cells(Target.Row, 2) = Application.VLookup(Cells(Target.Row, 5), Sheet1.Range("f1:g" & x), 2, 0)
    
19.     Cells(Target.Row, 3) = "散水"
    
20.     Cells(Target.Row, 9) = "KG"
    
21. ElseIf Target.Column = 11 Then
    
22.     If Target <> "" Then
    
23.         Set c = Sheet1.[a:a].Find(Target, LookIn:=xlValues, lookat:=xlPart)
    
24.         If Not c Is Nothing Then Target.Offset(0, 1) = c
    
25.     End If
    
26. Else
    
27.     Exit Sub
    
28. End If
    
29. Application.EnableEvents = True
    
30. End Sub
    
31. 
    

复制代码

419837499

蓝桥玄霜 发表于 2018-6-11 14:54

蓝桥老师, 谢谢你能回复, 经测试运行这些代码的结果如附图: