[已解决]vba代码优化问题

相交的平行线

各位老师好！       附件为本人本次求助问题，详见附件。根据四位编码求和（四位编码是根据六位编码  左往右取4位）。代码已写完成，但是数据一多，代码执行
就相对较慢。现求助，可否用字典+数组完成？
原始代码如下：

1. Sub 晚班报表()
   
2. Application.DisplayAlerts = False
   
3. Application.ScreenUpdating = False
   
4. Dim strPath As String, i As String, j As String, wb As Workbook, wk As Workbook
   
5. Dim a As Long, b As Long, k As Double
   
6. strPath = ThisWorkbook.Path
   
7. strPath = strPath & IIf(Right(strPath, 1) = "", "", "")
   
8. i = Dir(strPath & "报表.xls*")
   
9. j = Dir(strPath & "销售明细.xls*")
   
10. Set wb = Workbooks.Open(strPath & i)
    
11. Set wk = Workbooks.Open(strPath & j)
    
12. For b = 4 To wb.Worksheets(1).Range("B2").CurrentRegion.Rows.Count + 1
    
13.     k = 0
    
14.     For a = 2 To wk.Worksheets(1).Range("A1").CurrentRegion.Rows.Count
    
15.         If Left(wk.Worksheets(1).Cells(a, 5), 4) = wb.Worksheets(1).Cells(b, 2) Then
    
16.             k = k + wk.Worksheets(1).Cells(a, 4)
    
17.         End If
    
18.     Next
    
19.     wb.Worksheets(1).Cells(b, 4) = k
    
20. Next
    
21. With wb
    
22.     .Save
    
23.     .Close
    
24. End With
    
25. wk.Close
    
26. Application.DisplayAlerts = True
    
27. Application.ScreenUpdating = True
    
28. End Sub

复制代码

请老师们指教，谢谢！

最佳答案

月排行榜 / 总排行榜

釜底抽薪

2022-3-14 10:23

报表.zip (37.77 KB, 下载次数: 12)

2022-3-14 11:52 上传

点击文件名下载附件

跳转到最佳答案楼层

釜底抽薪

报表.zip (37.77 KB, 下载次数: 12)

2022-3-14 11:52 上传

点击文件名下载附件