请前辈们看下怎么优化能让代码毒素更快

zhanghonghai · 发表于 2024-8-26 22:17

Sub 区域国家定价()
Dim i, x, d, wt As Long, f1, f2 As Double, sh As Worksheet
'wt = Cells(2, 9) '克重值
For x = 5 To Cells(Rows.Count, 2).End(xlUp).Row '统计商品id列表的行数
wt = Cells(x, 9)
For Each sh In Worksheets '遍历工作表名称
If sh.Name = Cells(x, 7) Then '查找符合邮寄方式的运费工作表
For i = 2 To sh.Cells(Rows.Count, 3).End(xlUp).Row '统计运费表国家列的行数
For d = 11 To Sheet7.Cells(3, Columns.Count).End(xlToLeft).Column '统计第三行区域国家的列数
If Sheet7.Cells(3, d) = sh.Cells(i, 3) Then '在符合邮寄方式的运费工作表中匹配目的国
If wt > sh.Cells(i, 4) And wt <= sh.Cells(i, 5) Then '判断重量的区间范围
If wt <= sh.Cells(i, 6) Then '判断重量的首重
f1 = sh.Cells(i, 7) + sh.Cells(i, 10) '当前面条件成立并且小于等于首重的计算方法:首重运费+挂号费
Cells(x, d + 1) = ((Cells(x, 8) + f1 + Cells(2, 12)) / (1 - Cells(2, 5) - Cells(2, 7) - Cells(2, 9))) / 0.6 '根据25%利润率计算出来的售价价格
Else
f2 = sh.Cells(i, 7) + Application.Ceiling(((wt - sh.Cells(i, 6)) / sh.Cells(i, 8)), 1) * sh.Cells(i, 9) + sh.Cells(i, 10) '当前面条件成立并且大于首重的计算方法:首重运费+（克重-首重）/续重单位重量*续重单价+挂号费
Cells(x, d + 1) = ((Cells(x, 8) + f2 + Cells(2, 12)) / (1 - Cells(2, 5) - Cells(2, 7) - Cells(2, 9))) / 0.6 '根据25%利润率计算出来的售价价格
End If
End If
End If
Next d
Next i
End If
Next sh
Next x
End Sub

复制代码

由于数据太多，此代码运行速度比较慢，要运行至少1分钟时间，各位前辈有没有什么好的思路能让代码运行速度更快

zhanghonghai · 发表于 2024-8-26 22:39

自己给自己顶一下

taller · 发表于 2024-8-27 03:19

频繁读写工作表单元格导致代码运行速度慢，请使用数组+字典提速

ykcbf1100 · 发表于 2024-8-27 07:44

用字典+数组，速度会快很多。
就是你没有需求说明，光看你代码，要理解你的需求还是需要费不少时间的。建议还是你自己改一下吧。

jaxxcyh · 发表于 2024-8-27 08:14

taller 发表于 2024-8-27 03:19
频繁读写工作表单元格导致代码运行速度慢，请使用数组+字典提速

3楼说的对。循环中去切记不要总是去频繁读写单元格，这是影响速度的最主要因素。一般的做法，都是先将工作表中要处理的单元格区域一次性读取到数组里，arr=range.value ，一条语句就可以。后续对单元格的操作都转向对数组元素的操作。cells(i,j) 完全可以对应数组元素 arr(i,j)。等数组操作完毕，就可以写回到单元格，range.value=arr 一条语句就可以完成。

zhanghonghai · 发表于 2024-8-27 08:51

taller 发表于 2024-8-27 03:19
频繁读写工作表单元格导致代码运行速度慢，请使用数组+字典提速

谢谢我尝试改一下试试

zhanghonghai · 发表于 2024-8-27 08:52

ykcbf1100 发表于 2024-8-27 07:44
用字典+数组，速度会快很多。
就是你没有需求说明，光看你代码，要理解你的需求还是需要费不少时间的。建 ...

谢谢我尝试改一下试试看

chxw68 · 发表于 2024-8-27 09:29

Sub test()
Dim r%, i%
Dim arr, brr
Dim ws As Worksheet
Dim d As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
tt = Timer
For Each ws In Worksheets
If ws.Name <> "线上产品运营" Then
Set d(ws.Name) = CreateObject("scripting.dictionary")
With ws
.AutoFilterMode = False
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:o" & r)
For i = 1 To UBound(arr)
d(ws.Name)(arr(i, 3)) = Array(arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8), arr(i, 9), arr(i, 10))
Next
End With
End If
Next
With Worksheets("线上产品运营")
.AutoFilterMode = False
cs = .Range("a2:l2")
r = .Cells(.Rows.Count, 2).End(xlUp).Row
c = .Cells(4, .Columns.Count).End(xlToLeft).Column
arr = .Range("a3").Resize(r - 2, c)
For i = 3 To UBound(arr)
If d.exists(arr(i, 7)) Then
For j = 11 To UBound(arr, 2) Step 2
If d(arr(i, 7)).exists(arr(1, j)) Then
brr = d(arr(i, 7))(arr(1, j))
If arr(i, 9) > brr(0) And arr(i, 9) < brr(1) Then
If arr(i, 9) <= brr(2) Then
arr(i, j + 1) = (arr(i, 8) + brr(3) + brr(6) + cs(1, 12)) / (1 - cs(1, 5) - cs(1, 7) - cs(1, 9)) / 0.6
Else
f2 = brr(4) + Application.Ceiling((arr(i, 9) - brr(2)) / brr(4), 1) * brr(5) + brr(6)
arr(i, j + 1) = (arr(i, 8) + f2 + cs(1, 12)) / (1 - cs(1, 5) - cs(1, 7) - cs(1, 9)) / 0.6
End If
End If
End If
Next
End If
Next
.Range("a3").Resize(r - 2, c) = arr
End With
Application.ScreenUpdating = True
MsgBox Timer - tt
End Sub

复制代码

chxw68 · 发表于 2024-8-27 09:29

参与一下。

sunya_0529 · 发表于 2024-8-27 21:32

WPS里的JSA练习一下——

微信截图_20240827212737.png

		自动登录	找回密码
密码			免费注册

[求助] 请前辈们看下怎么优化能让代码毒素更快