代码长了求老师帮忙优化 谢谢

jerry3770

代码长了求老师帮忙优化 谢谢，好像我把简单的事复杂化了

yynrzwh

代码太长求简化.zip (128.38 KB, 下载次数: 6)

2024-5-5 17:24 上传

点击文件名下载附件

jerry3770

yynrzwh 发表于 2024-5-5 17:24

老师谢谢您的整理  但速度没有我以前的快了。

shiruiqiang

很多代码重复，不用写

henjiyunluo

jerry3770 发表于 2024-5-5 17:43
老师谢谢您的整理  但速度没有我以前的快了。

速度差很多么

半百

lkqsmxw

Sub abtoab2() '带改进  运行太慢了
Range("ab4:ab50000").Delete
T1 = Timer
k = Sheet2.Range("a65536").End(xlUp).Row: L = Sheet1.Range("aa65536").End(xlUp).Row
kkk = Range("aa65536").End(xlUp).Row
ReDim Brr(1 To kkk): Dim ii As Integer, kc As Integer, f As Integer, m As Integer
Set d = CreateObject("Scripting.Dictionary")
arr库存 = Sheet2.Range("a2:i" & k)
   For kc = 1 To k - 1
     If arr库存(kc, 1) <> "" And arr库存(kc, 9) > 0 Then
     If arr库存(kc, 8) Like "*" & "委外仓" & "*" = True Then
       d(arr库存(kc, 1)) = d(arr库存(kc, 1)) + arr库存(kc, 9) * 0.9
       Else
       d(arr库存(kc, 1)) = d(arr库存(kc, 1)) + arr库存(kc, 9)
      End If
      End If
   Next
'-------------------
With Sheet1
.Range(.Cells(3, 27), .Cells(d.Count + 3 - 1, 27)) = WorksheetFunction.Transpose(d.keys)
.Range(.Cells(3, 28), .Cells(d.Count + 3 - 1, 28)) = WorksheetFunction.Transpose(d.items)
End With
Set d = Nothing
T2 = Timer: MsgBox T2 - T1
End Sub

jerry3770

lkqsmxw 发表于 2024-5-6 14:56
Sub abtoab2() '带改进  运行太慢了
Range("ab4:ab50000").Delete
T1 = Timer

谢谢老师的回复  您的代码字典直接输出时料号是乱序的，我的输出是料号对应相应的数量 。这句以上的部份（工作表逻辑复杂）不用改：ReDim arra(1 To d.Count, 1 To 2)

jerry3770

shiruiqiang 发表于 2024-5-5 17:47
很多代码重复，不用写

谢谢老师的解答   您这只是做了个去重汇总   我这句后面的功能您帮我省掉了（ReDim arra(1 To d.Count, 1 To 2（这句以前可以不用改）)，这是料号对应相对的数量1对1输出，相当于做了次VLOOKUP查找哦。

jerry3770

半百 发表于 2024-5-6 13:06

谢谢老师  您是结果非常正确，5000行速度0.2秒  我的原代码要6秒。学习了。您真历害