[已解决]求助修改代码

jiangjian138

Worksheet_Change事件代码为什么删除分摊表的时候会出现“类型不匹配”的错误？要怎么修改代码才能不会出现这个情况，感谢 求助.rar (64.04 KB, 下载次数: 5)

2015-3-9 00:17 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2015-3-9 09:15

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.     On Error GoTo err1
   
4.     If Target = "" Then Exit Sub
   
5. 
   
6.     Dim Myc%, rng As Range, d, Myr&, Arr, Crr, i&, dc
   
7.     Myc = [iv1].End(xlToLeft).Column + 1
   
8.     Myr = Cells(Rows.Count, 1).End(xlUp).Row + 1
   
9.     Set rng = Union(Cells(1, 5).Resize(1, Myc - 4), Cells(8, 1).Resize(Myr - 7))
   
10.     If Intersect(rng, Target) Is Nothing Then Application.EnableEvents = True: Exit Sub
    
11.     If Target = "" Then Exit Sub
    
12.     Set d = CreateObject("Scripting.Dictionary")
    
13.     Set dc = CreateObject("Scripting.Dictionary")
    
14.     Arr = Sheet2.[a1].CurrentRegion
    
15.     For i = 1 To UBound(Arr)
    
16.         If Arr(i, 1) <> "" Then d(Arr(i, 1)) = ""
    
17.         If Arr(i, 3) <> "" Then dc(Arr(i, 3)) = ""
    
18.     Next
    
19. 
    
20.     If Target.Row = 1 Then
    
21.         If Not dc.exists(Target.Value) Then MsgBox "成本中心错误": Target = ""
    
22.     Else
    
23.         If Not d.exists(Target.Value) Then MsgBox "预算段错误": Target = ""
    
24.     End If
    
25. err1:
    
26.     Application.EnableEvents = True
    
27. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. If Target = "" Then Exit Sub

复制代码

执行完删除操作后，target实际上已经无效了。
你看看本地窗口中target对象

hwc2ycy

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.     On Error GoTo err1
   
4.     If Target = "" Then Exit Sub
   
5. 
   
6.     Dim Myc%, rng As Range, d, Myr&, Arr, Crr, i&, dc
   
7.     Myc = [iv1].End(xlToLeft).Column + 1
   
8.     Myr = Cells(Rows.Count, 1).End(xlUp).Row + 1
   
9.     Set rng = Union(Cells(1, 5).Resize(1, Myc - 4), Cells(8, 1).Resize(Myr - 7))
   
10.     If Intersect(rng, Target) Is Nothing Then Application.EnableEvents = True: Exit Sub
    
11.     If Target = "" Then Exit Sub
    
12.     Set d = CreateObject("Scripting.Dictionary")
    
13.     Set dc = CreateObject("Scripting.Dictionary")
    
14.     Arr = Sheet2.[a1].CurrentRegion
    
15.     For i = 1 To UBound(Arr)
    
16.         If Arr(i, 1) <> "" Then d(Arr(i, 1)) = ""
    
17.         If Arr(i, 3) <> "" Then dc(Arr(i, 3)) = ""
    
18.     Next
    
19. 
    
20.     If Target.Row = 1 Then
    
21.         If Not dc.exists(Target.Value) Then MsgBox "成本中心错误": Target = ""
    
22.     Else
    
23.         If Not d.exists(Target.Value) Then MsgBox "预算段错误": Target = ""
    
24.     End If
    
25. err1:
    
26.     Application.EnableEvents = True
    
27. End Sub
    

复制代码