有个traget的疑难杂症，一直找不到原因~

冰封气流

德茨管理系统.zip (392.67 KB, 下载次数: 8)

2023-2-20 17:28 上传

点击文件名下载附件

1. Private Sub Worksheet_Change(ByVal Target As Range)        '就这个过程，出现问题~
   
2. Dim wb1 As Worksheet, wb2 As Worksheet, rag As Range, i As Integer, txt, rags As Range, 行1 As Byte, 行2 As Integer
   
3.     Set wb1 = Worksheets("销售单")
   
4.     Set wb2 = Worksheets("数据源")
   
5.     If Target.Count <> 1 Then Exit Sub
   
6.     If Intersect(Target, Range("b7:m16")) Is Nothing Then Exit Sub
   
7.     i = wb2.Range("b" & wb2.Cells.Rows.Count).End(xlUp).Row
   
8.     If Target.MergeArea.Cells(1, 1) <> "" Then
   
9.         txt = Target.MergeArea.Cells(1, 1)
   
10.     Else
    
11.         End
    
12.     End If
    
13.     行1 = Target.Row
    
14.     If txt = "" Then End
    
15.     Set rags = wb2.Range("b2:b" & i)
    
16.     Set rag = rags.Find(what:=txt, LookIn:=xlValues, Lookat:=xlWhole)
    
17.     If rag Is Nothing Then
    
18.         MsgBox "查无此产品"
    
19.         Exit Sub
    
20.     Else
    
21.         行2 = rag.Row
    
22.         wb1.Range("f" & 行1) = wb2.Range("c" & 行2)     '为什么运行到这一步就会中断~
    
23.         wb1.Range("i" & 行1) = wb2.Range("d" & 行2)
    
24.         wb1.Range("j" & 行1) = wb2.Range("e" & 行2)
    
25.         wb1.Range("k" & 行1) = wb2.Range("f" & 行2)
    
26.         wb1.Range("l" & 行1) = wb2.Range("g" & 行2)
    
27.     End If
    
28.    Range("l7").Select
    
29.     Selection.Formula = "=if(b7=" & """" & "" & """" & "," & """" & "" & """" & ",i7*k7)"
    
30.     Range("l7").Select
    
31.     Selection.AutoFill Destination:=Range("l7:l16"), Type:=xlFillDefault
    
32.     Range("l7:l16").Select
    
33. End Sub

复制代码

大佬们，帮忙看看哈，运行到 wb1.Range("f" & 行1) = wb2.Range("c" & 行2) 这一步就会从头运行，求解决~

zjzyj

......

If Intersect(Target, Range("b7:m16")) Is Nothing Then Exit Sub
Application.EnableEvents = False   '关闭事件响应
i = wb2.Range("b" & wb2.Cells.Rows.Count).End(xlUp).Row

......

Range("l7:l16").Select
Application.EnableEvents = True '重新开启事件响应
End Sub

zxsea_7426

数据修改会继续触发这一事件。当然就会在这里不停的循环
二楼正解，需要关闭事件响应

taller

wb1.Range("f" & 行1) = wb2.Range("c" & 行2) -- 事件代码中没有这行代码呀

冰封气流

zjzyj 发表于 2023-2-20 22:12
......

If Intersect(Target, Range("b7:m16")) Is Nothing Then Exit Sub

明白了，找到原因了，我说怎么莫名其妙的会循环两次的~

冰封气流

zxsea_7426 发表于 2023-2-21 07:36
数据修改会继续触发这一事件。当然就会在这里不停的循环
二楼正解，需要关闭事件响应

明白了，找到原因了，我说怎么莫名其妙的会循环两次的~