请老师帮忙看看哪里出了问题？查询数据需要20多秒，先谢了

完美交易88

yylucke 发表于 2023-5-24 14:50
因为你用了change事件，意味着，每变更一次就要执行那个超大的代码，至少执行了10次

谢谢，那我用什么方法好呢，新手学习中。

完美交易88

yylucke 发表于 2023-5-24 14:57
在程序开始加语句Application.EnableEvents = False
在程序结尾及Exit sub这样的代码上面一行加Applicatio ...

谢谢！学习中

完美交易88

yynrzwh 发表于 2023-5-24 15:45
下断点就知道了。
代码似乎不停地触发change事件

谢谢，学习中。

完美交易88

tanglf188 发表于 2023-5-24 16:13
1、Application.EnableEvents = False　临时取消过程运行时事件的发生
2、Application.SumIf([已销售!a1: ...

谢谢，学习了。

完美交易88

fanyoulin 发表于 2023-5-24 16:02
附件与需求描述不符：
1、代码段有好多，哪一个需要20秒？
2、随便执行了“参展”表的代码，“已销售”、 ...

你好，我的需求是在现场扫书页录入书号，然后判断一下书号的正确性（必需是13位、而且是以978或979开头），如果在参展内有相同的书号，把相应列的内容写入现场扫书内，我用的是change事件，每触发单元格都执行一下，是不是这里出现了问题？帮忙写一下代码学习一下，先谢了。

smiletwo

频繁操作cell、range,快得了才怪
建议，描述需求

zpy2

完美交易88 发表于 2023-5-24 17:43
你好，我的需求是在现场扫书页录入书号，然后判断一下书号的正确性（必需是13位、而且是以978或979开头） ...

相应列的内容写入现场扫书内？

每次写入？
回库        已扫        找书订户        找书数量       

这步慢吗？

tel3033

供参考……

tel3033

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Application.EnableEvents = False
   
3. Dim arr, brr, ar, i%, x, tt, d As Object
   
4.     tt = Timer
   
5.     If Target.CountLarge > 1 Then Exit Sub
   
6.     If Target.Row = 1 Then Exit Sub
   
7.     If Target.Column = 1 Then
   
8.         x = Target.Value
   
9.         If Len(x) <> 13 Then
   
10.             Target.Offset(0, 2) = "书号错": Application.EnableEvents = True: Exit Sub
    
11.         Else
    
12.             If Left(x, 3) = "978" Or Left(x, 3) = "979" Then
    
13.             Set d = CreateObject("Scripting.Dictionary")
    
14.                 With Sheets("参展")
    
15.                     arr = .[a1].CurrentRegion
    
16.                     For i = 2 To UBound(arr)
    
17.                         d(arr(i, 1)) = i
    
18.                     Next
    
19.                 End With
    
20.                 With Sheets("现场扫书")
    
21.                     If d.exists(x) Then
    
22.                         brr = .[a1].CurrentRegion
    
23.                         For i = 2 To UBound(brr)
    
24.                             d("@" & brr(i, 1)) = d("@" & brr(i, 1)) + 1
    
25.                         Next
    
26.                         ar = Target.Resize(1, 10)
    
27.                         ar(1, 2) = arr(d(x), 12)   '把找书订户复制过来
    
28.                         ar(1, 3) = arr(d(x), 13)   '把找书数量复制过来
    
29.                         ar(1, 4) = arr(d(x), 7)    '把参展数量复制过来
    
30.                         ar(1, 5) = arr(d(x), 8)    '把销售数量复制过来
    
31.                         ar(1, 6) = arr(d(x), 9)    '把已转移数量复制过来
    
32.                         ar(1, 7) = arr(d(x), 10)   '把回库数量复制过来
    
33.                         ar(1, 8) = 1               '扫书数量记录为1
    
34.                         ar(1, 9) = arr(d(x), 6)    '把参展出库的书店分类复制过来
    
35.                         ar(1, 10) = .[k1]          '将J1单元格的架位复制到架位号列内
    
36.                         If d("@" & x) > 1 Then ar(1, 2) = "重复"
    
37.                         If d("@" & x) > ar(1, 7) Then MsgBox "盘点数量大于回库，查看是否多书！"
    
38.                         Target.Resize(1, 10) = ar
    
39.                     Else
    
40.                         Target.Offset(0, 7) = 1
    
41.                         Target.Offset(0, 9) = .[k1]
    
42.                         Target.Offset(0, 1) = "查无" '如果参展内没有，标记查无
    
43.                         Target.Offset(0, 1).Speak  '朗读查无
    
44.                     End If
    
45.                 End With
    
46.             Set d = Nothing
    
47.             Else
    
48.                 Target.Offset(0, 2) = "书号错"
    
49.             End If
    
50.         End If
    
51.     End If
    
52.     Target.Offset(0, 2).Speak
    
53. MsgBox "OK! 运行时间：" & Format(Timer - tt, "0.00000") & "秒"
    
54. Application.EnableEvents = True
    
55. End Sub

复制代码

完美交易88

tel3033 发表于 2023-5-24 19:27

谢谢老师，有个问题请老师在帮忙看看，为什么删除一整行或一整列，如果再次录入书号，就不触发Change事件了，字典这块还不太会，有些看不明白