Question

我使用此宏将多个Excel文件中的数据加载到一个主表中。此代码比实际代码缩短。实际上，我有更多的行以GetData myFile开头。代码重复，我假设有更好的方法来更快地运行此宏。

Sub Recurse2()
Dim DSO As New FileSystemObject
Dim myFolder As Scripting.Folder, mySubFolder As Scripting.Folder
Dim myFile As File
Dim sPath$: sPath = "\\zts-fs1\kv$\Merné\Naposledy_merane_zily\"
Dim R$
Dim i As Integer
Dim test As String

test = "Otvor test!"
R = Join(Application.Transpose(Sheets("linky_zila").UsedRange), "|")
Set myFolder = DSO.GetFolder(sPath)
For Each mySubFolder In myFolder.SubFolders
    For Each myFile In mySubFolder.Files
        DoEvents
        If Not (InStr(1, R, myFile.Path) > 0) Then

            GetData myFile, "Vystupna_kontrola", "D4:D5", Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1), Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)), True, False

            GetData myFile, "Vystupna_kontrola", "S4:S5", Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2), Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)), True, False

            GetData myFile, "Vystupna_kontrola", "A8:A9", Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 3).End(xlUp).Row + 1, 3), Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 3).End(xlUp).Row + 1, 3)), True, False

            GetData myFile, "Vystupna_kontrola", "E8:E9", Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 4).End(xlUp).Row + 1, 4), Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 4).End(xlUp).Row + 1, 4)), True, False

            GetData myFile, "Vystupna_kontrola", "F8:F9", Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 5).End(xlUp).Row + 1, 5), Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 5).End(xlUp).Row + 1, 5)), True, False


            Sheets("test_zila").Range("U3", "U50000").NumberFormat = "dd/mm"
            Sheets("test_zila").Range("V3", "V50000").NumberFormat = "hh:mm"

            Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 25).End(xlUp).Row + 1, 25), Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 25).End(xlUp).Row + 1, 25)).Formula = "=HYPERLINK(""" & myFile.Path & """ ,""" & test & """)"

            Sheets("linky_zila").Cells(Sheets("linky_zila").UsedRange.Rows.Count + 1, 1).Value = myFile.Path
            R = R & myFile.Path & "|"

           For i = 1 To 23
               If Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 1).End(xlUp).Row, 1 + i), Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 1).End(xlUp).Row, 1 + i)).Value = "" Then
                   Sheets("test_zila").Range(Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count, 1).End(xlUp).Row, 1 + i),   Sheets("test_zila").Cells(Sheets("test_zila").Cells(Rows.Count,  1).End(xlUp).Row, 1 + i)).Value = "/"
                End If
            Next
        End If
    Next
Next
Set DSO = Nothing
Set myFolder = Nothing
Set mySubFolder = Nothing
Set myFile = Nothing
End Sub

Answer 1

添加Application.ScreenUpdating = false，如nhee所说，并使用With ... End With语句替换某些值，以便更可重复，速度更快。并预先计算Rows.count！：

Sub Recurse2()
 Dim DSO As New FileSystemObject
 Dim myFolder As Scripting.Folder, mySubFolder As Scripting.Folder
 Dim myFile As File
 Dim sPath$: sPath = "\\zts-fs1\kv$\Merné\Naposledy_merane_zily\"
 Dim R$
 Dim i As Integer
 Dim test As String
 Dim rowsCount as integer

 Application.ScreenUpdating=false
 test = "Otvor test!"
 R = Join(Application.Transpose(Sheets("linky_zila").UsedRange), "|")
 Set myFolder = DSO.GetFolder(sPath)
 rowsCount=Rows.count
 With Sheets("test_zila")
 For Each mySubFolder In myFolder.SubFolders
   For Each myFile In mySubFolder.Files
    DoEvents
    If Not (InStr(1, R, myFile.Path) > 0) Then

        GetData myFile, "Vystupna_kontrola", "D4:D5", .Range(.Cells(.Cells(rowsCount, 1).End(xlUp).Row + 1, 1), .Cells(.Cells(rowsCount, 1).End(xlUp).Row + 1, 1)), True, False

        GetData myFile, "Vystupna_kontrola", "S4:S5", .Range(.Cells(.Cells(rowsCount, 2).End(xlUp).Row + 1, 2), .Cells(.Cells(rowsCount, 2).End(xlUp).Row + 1, 2)), True, False

        GetData myFile, "Vystupna_kontrola", "A8:A9", .Range(.Cells(.Cells(rowsCount, 3).End(xlUp).Row + 1, 3), .Cells(.Cells(rowsCount, 3).End(xlUp).Row + 1, 3)), True, False

        GetData myFile, "Vystupna_kontrola", "E8:E9", .Range(.Cells(.Cells(rowsCount, 4).End(xlUp).Row + 1, 4), .Cells(.Cells(rowsCount, 4).End(xlUp).Row + 1, 4)), True, False

        GetData myFile, "Vystupna_kontrola", "F8:F9", .Range(.Cells(.Cells(rowsCount, 5).End(xlUp).Row + 1, 5), .Cells(.Cells(rowsCount, 5).End(xlUp).Row + 1, 5)), True, False


        .Range("U3", "U50000").NumberFormat = "dd/mm"
        .Range("V3", "V50000").NumberFormat = "hh:mm"

        .Range(.Cells(.Cells(rowsCount, 25).End(xlUp).Row + 1, 25), .Cells(.Cells(rowsCount, 25).End(xlUp).Row + 1, 25)).Formula = "=HYPERLINK(""" & myFile.Path & """ ,""" & test & """)"

        Sheets("linky_zila").Cells(Sheets("linky_zila").UsedRange.Rows.Count + 1, 1).Value = myFile.Path
        R = R & myFile.Path & "|"

       For i = 1 To 23
           If .Range(.Cells(.Cells(rowsCount, 1).End(xlUp).Row, 1 + i), .Cells(.Cells(rowsCount, 1).End(xlUp).Row, 1 + i)).Value = "" Then
               .Range(.Cells(.Cells(rowsCount, 1).End(xlUp).Row, 1 + i), .Cells(.Cells(rowsCount,  1).End(xlUp).Row, 1 + i)).Value = "/"
            End If
        Next
    End If
  Next
 Next
 End With
 Set DSO = Nothing
 Set myFolder = Nothing
 Set mySubFolder = Nothing
 Set myFile = Nothing
 Application.ScreenUpdating=True
End Sub

更快地运行宏

1 个答案: