麻烦老师帮忙优化一下这条重复读取同一文件的代码

脚毛乱了

这条代码只读取一个源文件uvuv.xlsx数据，在执行的时候可以看到它反复读取关闭源文件，感觉可以一次提取完的
Sub test()
    Dim Arr, myPath$, myName$, Arrl, Myr&, rq
    Application.ScreenUpdating = False
    Sheet1.Activate
    rq = Sheet1.Range("C3")
            [j3:j5].ClearContents
    myPath = ThisWorkbook.Path & "\"
    myName = Dir(myPath & "uvuv.xlsx")
    Do While myName <> ""
        With GetObject(myPath & myName)
            Arrl = .Sheets(1).UsedRange: n = 2
            For i = 2 To UBound(Arrl)
                If rq = Arrl(i, 4) And Sheet1.Range("Z3") = Arrl(i, 3) Then
                    n = n + 1
                        Cells(n, 10) = Arrl(i, 5)
                End If
            Next
            .Close False
        End With
        myName = Dir
    Loop
            [j6:j8].ClearContents
    myPath = ThisWorkbook.Path & "\"
    myName = Dir(myPath & "uvuv.xlsx")
    Do While myName <> ""
        With GetObject(myPath & myName)
            Arrl = .Sheets(1).UsedRange: n = 5
            For i = 2 To UBound(Arrl)
                If rq = Arrl(i, 4) And Sheet1.Range("Z6") = Arrl(i, 3) Then
                    n = n + 1
                        Cells(n, 10) = Arrl(i, 5)
                End If
            Next
            .Close False
        End With
        myName = Dir
    Loop
            [j9:j11].ClearContents
    myPath = ThisWorkbook.Path & "\"
    myName = Dir(myPath & "uvuv.xlsx")
    Do While myName <> ""
        With GetObject(myPath & myName)
            Arrl = .Sheets(1).UsedRange: n = 8
            For i = 2 To UBound(Arrl)
                If rq = Arrl(i, 4) And Sheet1.Range("Z9") = Arrl(i, 3) Then
                    n = n + 1
                        Cells(n, 10) = Arrl(i, 5)
                End If
            Next
            .Close False
        End With
        myName = Dir
    Loop
            [j12:j14].ClearContents
    myPath = ThisWorkbook.Path & "\"
    myName = Dir(myPath & "uvuv.xlsx")
    Do While myName <> ""
        With GetObject(myPath & myName)
            Arrl = .Sheets(1).UsedRange: n = 11
            For i = 2 To UBound(Arrl)
                If rq = Arrl(i, 4) And Sheet1.Range("Z12") = Arrl(i, 3) Then
                    n = n + 1
                        Cells(n, 10) = Arrl(i, 5)
                End If
            Next
            .Close False
        End With
        myName = Dir
    Loop
            [j15:j17].ClearContents
    myPath = ThisWorkbook.Path & "\"
    myName = Dir(myPath & "uvuv.xlsx")
    Do While myName <> ""
        With GetObject(myPath & myName)
            Arrl = .Sheets(1).UsedRange: n = 14
            For i = 2 To UBound(Arrl)
                If rq = Arrl(i, 4) And Sheet1.Range("Z15") = Arrl(i, 3) Then
                    n = n + 1
                        Cells(n, 10) = Arrl(i, 5)
                End If
            Next
            .Close False
        End With
        myName = Dir
    Loop

microyip

反复打开读写是必然的，这个不是效率低的关键问题，主要是代码在反复读写单元格。另外提高效率，可以用SQL+数组来完成。仅提供思路

3190496160

楼主的代码就多次打开文件的呀，其实，如果只是需要从一个工作簿文件中取数的话，打开一次文件即可，而且，也没有必要用do while  循环的

脚毛乱了

3190496160 发表于 2020-5-30 17:25
楼主的代码就多次打开文件的呀，其实，如果只是需要从一个工作簿文件中取数的话，打开一次文件即可，而且， ...

小白不懂怎么操作，用的方法是最蠢的办法直接把代码拼接起来，这个代码原本来自于读取多个工作簿的，我修改了就读取一个工作簿取数，能不能就这段代码写一段只打开一次文件的例子供参考

microyip

照搬照套，是临时解决问题的方法，学以致用，才是正道！

脚毛乱了

microyip 发表于 2020-5-30 17:42
照搬照套，是临时解决问题的方法，学以致用，才是正道！

初来论坛的时候连照搬照套都不会

脚毛乱了

顶上去 ，寻找答案

3190496160

上传附件，并具体说明你要做什么，才可能写代码的呀

脚毛乱了

3190496160 发表于 2020-5-30 21:49
上传附件，并具体说明你要做什么，才可能写代码的呀

上传附件了，能看一下吗？

3190496160

目前的表格设计似乎是有问题的，目前，每个店铺预留三行，你能保证每个店铺都是三行吗？？
统计表格事先根本没必要输入第二行一下的信息，代码自动获取即可