手动插入行或列就卡不动了

倔强男孩

手动插入行或列就卡不动了，有触发Worksheet_Change，哪位有空帮忙看看指点一下，谢谢！

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. On Error Resume Next
   
3.    Dim c, c1, c3
   
4.    Dim arr As Integer, arr1 As Integer, arr3 As Integer
   
5.    Dim mrow As Integer, mrow1 As Integer
   
6.    Dim brng As String, crng As String, brng1 As String, crng1 As String, brng2 As String
   
7.    
   
8.    Application.ScreenUpdating = False
   
9.     mrow = Target.Row
   
10. If Target.Column <> 6 Then Exit Sub
    
11.     If Target.Row < 3 Then Exit Sub
    
12.                 mrow = Target.Row
    
13. 
    
14.        Set c1 = Sheet3.[B:B].Find(Target.Value, , , 1) '模具清单
    
15.        Set c11 = Sheet8.[A:A].Find(Target.Value, , , 1) '单价表
    
16.                     If Application.CountIf(Sheet3.[B:B], Target.Value) >= 1 Then
    
17.                         Target.Offset(0, -1) = c1.Offset(0, -1)
    
18.                         c1.Offset(0, 1).Copy Target.Offset(0, 6) ' 模具编号
    
19.                         Target.Offset(0, 7) = c1.Offset(0, 2) '材料
    
20.                         Target.Offset(0, 8) = c1.Offset(0, 3) '宽
    
21.                         Target.Offset(0, 9) = c1.Offset(0, 4) '步距
    
22.                         Target.Offset(0, 10) = c1.Offset(0, 5) '厚
    
23.                         Target.Offset(0, 11) = c1.Offset(0, 6) '产品单重
    
24.                         Target.Offset(0, 19) = c1.Offset(0, 8) '存货编码
    
25.                         Target.Offset(0, 21) = c1.Offset(0, 7) '存货编码
    
26.                         Target.Offset(0, 14) = c1.Offset(0, 9) '产品名称
    
27.                         Range("Ae" & mrow) = c1.Offset(0, 10) '产品规格
    
28.                         Range("s" & mrow) = c1.Offset(0, 11) '后工序处理
    
29.                         Range("I" & mrow) = c11.Offset(0, 1) '单价
    
30.                         Range("Ad" & mrow) = (Now()) '入单时间
    
31.                     End If
    
32.    
    
33. '------------------------------------------------------------------库存
    
34.    Set c = Sheet4.[A:A].Find(Target.Value, , , 1)
    
35.        If Application.CountIf(Sheet4.[A:A], Target.Value) >= 1 Then
    
36.          Target.Offset(0, 3) = c.Offset(0, 2)
    
37.                  c.EntireRow.Delete
    
38.       
    
39.         End If
    
40. '------------------------------------------------------------------输入公式
    
41.          brng = Range("h" & mrow) '订单数量
    
42.          crng = Range("Q" & mrow) '产品单重
    
43.          jrng = Range("j" & mrow) '每小时产量
    
44.          frng = Range("AD" & mrow) '已领重量
    
45.          Range("R" & mrow).Formula = "=" & "(" & brng & "*" & crng & ")" & "*" & 1.05
    
46.          Range("A" & mrow).Formula = "=" & "(" & brng & "*" & crng & ")" & "*" & 1.05 & "-" & frng
    
47.          Range("c" & mrow).Formula = "=" & "h" & mrow & "/ " & "j" & mrow
    
48.           brng2 = Range("V" & mrow) '累计生产
    
49.           brng4 = Range("R" & mrow) '实际用料重量
    
50.           brng3 = Range("AA" & mrow) '产品净重
    
51.           crng2 = Range("AB" & mrow) '产品净重用料
    
52.          
    
53.            Range("AB" & mrow).Formula = "=" & "(" & brng3 & "*" & brng & ")"
    
54.            Range("aC" & mrow).Formula = "=" & "(" & brng4 & "-" & crng2 & ")"
    
55.      
    
56.           Application.ScreenUpdating = True
    
57. 
    
58.     Set c4 = Sheet16.[B:B].Find(Target.Value, , , 1)
    
59.        If Application.CountIf(Sheet16.[B:B], Target.Value) >= 1 Then
    
60.               品质异常查看表.项目.Text = c4
    
61.               品质异常查看表.客户.Text = c4.Offset(0, -1)
    
62.              品质异常查看表.日期.Text = c4.Offset(0, 1)
    
63.               品质异常查看表.登记员.Text = c4.Offset(0, 2)
    
64.               品质异常查看表.问题描述.Text = c4.Offset(0, 3)
    
65.               品质异常查看表.Show
    
66.               c4.EntireRow.Delete
    
67.          
    
68.            End If
    
69.    
    
70.     '----------------------------------------------------------------------清除
    
71. 
    
72.     If IsEmpty(Cells(mrow, 6)) Then
    
73.                  Cells(mrow, 6).EntireRow.Delete
    
74.             End If
    
75.         
    
76.     Application.ScreenUpdating = True
    
77.    Application.EnableEvents = True
    
78. Exit Sub
    
79. 
    
80. End Sub

复制代码

taller

倔强男孩

taller 发表于 2024-4-7 03:27

感谢版主指点！