请教一下各位老师关于引用其它workbook时提高运行速度的优化

yuason

我的方法是读取在一个文件后数据存在Set 里，然后选中指定的sheet存入数组，然后在把这个Set 清空掉，在读取下一个。。。循环往复大概有十几个文件，平均每个文件约5-7M，请教各位老师提高运行速度的方法




Sub 读取业务未交数据()
    Call 更新业务数据
    Application.ScreenUpdating = False '屏幕信息不更新
    On Error Resume Next
    Sheet10.[A:D].ClearContents
   
    Dim wb As Workbook
    Set wb = GetObject("C:\Users\Administrator\Desktop\业务数据\订单管理表(CX）2023年.xlsx")
    ReDim k(wb.Sheets(3).Range("A1").CurrentRegion.Rows.Count, wb.Sheets(3).Range("A1").CurrentRegion.Columns.Count)
    With wb.Sheets(3).Range("A1").CurrentRegion '要复制数据工作表的有数据区域
        k = .Value '将CX订单数据存入数组
    End With
    wb.Close False
   
    Dim wb1 As Workbook
    Set wb1 = GetObject("C:\Users\Administrator\Desktop\业务数据\订单管理(ZX）2023.xlsx")
    ReDim k1(wb1.Sheets(2).Range("A1").CurrentRegion.Rows.Count, wb1.Sheets(2).Range("A1").CurrentRegion.Columns.Count)
    With wb1.Sheets(2).Range("A1").CurrentRegion '要复制数据工作表的有数据区域
        k1 = .Value '将ZX订单数据存入数组
    End With
    wb1.Close False
   
    Dim wb2 As Workbook
    Set wb2 = GetObject("C:\Users\Administrator\Desktop\业务数据\2023 KH003.xlsx")
    ReDim k2(wb2.Sheets(4).Range("A1").CurrentRegion.Rows.Count, wb2.Sheets(4).Range("A1").CurrentRegion.Columns.Count)
    With wb2.Sheets(4).Range("A1").CurrentRegion '要复制数据工作表的有数据区域
        k2 = .Value '将KH003订单数据存入数组
    End With
    wb2.Close False
   
    Dim wb3 As Workbook
    Set wb3 = GetObject("C:\Users\Administrator\Desktop\业务数据\2023 KH017.xlsx")
    ReDim k3(wb3.Sheets(4).Range("A1").CurrentRegion.Rows.Count, wb3.Sheets(4).Range("A1").CurrentRegion.Columns.Count)
    With wb3.Sheets(4).Range("A1").CurrentRegion '要复制数据工作表的有数据区域
        k3 = .Value '将KH017订单数据存入数组
    End With
    wb3.Close False
   
'#上面只读取了4个表，感觉运行已经很卡了，很多次以为电脑死机。。。


    '合并数组
    ReDim po(1 To 8000, 1 To 4)
    i = 1
    For j = 1 To UBound(k) '循环CX的
        If Not IsError(k(j, 12)) Then
            If k(j, 18) <> 0 And Len(k(j, 12)) >= 10 And Left(k(j, 12), 1) = 2 Then
                po(i, 1) = k(j, 6) '客户料号
                po(i, 2) = k(j, 12) 'ERP料号
                po(i, 3) = k(j, 15) '物料描述
                po(i, 4) = k(j, 18) '未交数量
                i = i + 1
            End If
        End If
    Next
    For j1 = 1 To UBound(k1) '循环ZC的
        If Not IsError(k1(j1, 11)) Then
            If k1(j1, 16) <> 0 And k1(j1, 8) <> "客户料号" And Len(k1(j1, 11)) >= 10 And Left(k1(j1, 11), 1) = 2 Then
                po(i, 1) = k1(j1, 8) '客户料号
                po(i, 2) = k1(j1, 11) 'ERP料号
                po(i, 3) = k1(j1, 12) '物料描述
                po(i, 4) = k1(j1, 16) '未交数量
                i = i + 1
            End If
        End If
    Next
    For j2 = 1 To UBound(k2) '循环KH003
        If Not IsError(k2(j2, 9)) Then
            If k2(j2, 14) <> 0 And k2(j2, 7) <> "客户料号" And Len(k2(j2, 9)) >= 10 And Left(k2(j2, 9), 1) = 2 Then
                po(i, 1) = k2(j2, 7) '客户料号
                po(i, 2) = k2(j2, 9) 'ERP料号
                po(i, 3) = k2(j2, 11) '物料描述
                po(i, 4) = k2(j2, 14) '未交数量
                i = i + 1
            End If
        End If
    Next
    For j3 = 1 To UBound(k3) '循环KH017
        If Not IsError(k3(j3, 9)) Then
            If k3(j3, 14) <> 0 And k3(j3, 7) <> "客户料号" And Len(k3(j3, 9)) >= 10 And Left(k3(j3, 9), 1) = 2 Then
                po(i, 1) = k3(j3, 7) '客户料号
                po(i, 2) = k3(j3, 9) 'ERP料号
                po(i, 3) = k3(j3, 11) '物料描述
                po(i, 4) = k3(j3, 14) '未交数量
                i = i + 1
            End If
        End If
    Next
   
    Set dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(po)
        dic(po(i, 1)) = dic(po(i, 1)) + po(i, 4)
        If dic(po(i, 1)) = 0 Then dic(po(i, 1)) = ""
    Next
    Sheet10.[A2].Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    Sheet10.[D2].Resize(dic.Count, 1) = Application.Transpose(dic.items)
    Set dic = Nothing
    For i = 2 To Sheet10.Range("a200").End(3).Row
        Sheet10.Cells(i, 2) = Application.WorksheetFunction.VLookup(Sheet10.Cells(i, 1), Sheet4.Range("B:C"), 2, 0)
        Sheet10.Cells(i, 3) = Application.WorksheetFunction.VLookup(Sheet10.Cells(i, 1), Sheet4.Range("B:D"), 3, 0)
    Next
    Sheet10.[A1:D1] = Array("客户料号", "ERP料号", "物料描述", "未交货数")
    Application.ScreenUpdating = True

3190496160

目前的代码直接循环单元格，速度肯定慢，可以把数据复制给数组，然后在数组中循环，就可以大大提速
具体描述你的需求，上传相关附件，目前的代码是没有修改价值的