Excel代码遍历n个文件夹，如何提高下列代码速度，跪求

yundong95

Private Sub foldersearch()
Application.ScreenUpdating = False
Dim fso, f, n
Dim ttpath As String
ttpath = ThisWorkbook.Path + "\"

   Set fso = CreateObject("Scripting.FileSystemObject")
    n = 2
    For Each floder1 In fso.GetFolder(ttpath).SubFolders
        n = n + 1
        
        For Each f In floder1.Files
              
     If InStr(1, f.Name, "DM_") <> 0 Then
   Cells(n, "ad") = ttpath + floder1.Name + "\" + f.Name
   ActiveSheet.Hyperlinks.Add anchor:=Cells(n, "ad"), Address:=ttpath + floder1.Name + "\" + f.Name
    Cells(n, "ae") = ttpath + floder1.Name + "\"
   ActiveSheet.Hyperlinks.Add anchor:=Cells(n, "ae"), Address:=ttpath + floder1.Name + "\"
  
wb1 = ttpath + floder1.Name + "\" + f.Name
Cells(n, 2) = GetObject(wb1).Sheets(1).Cells(2, "c").Value
Cells(n, 3) = GetObject(wb1).Sheets(1).Cells(2, "w").Value
Cells(n, 4) = GetObject(wb1).Sheets(1).Cells(2, "aa").Value
Cells(n, 5) = GetObject(wb1).Sheets(1).Cells(6, "c").Value
Cells(n, 6) = GetObject(wb1).Sheets(1).Cells(2, "g").Value
Cells(n, 7) = GetObject(wb1).Sheets(1).Cells(2, "k").Value
Cells(n, 8) = GetObject(wb1).Sheets(1).Cells(2, "o").Value
Cells(n, 9) = GetObject(wb1).Sheets(1).Cells(2, "s").Value
Cells(n, 10) = GetObject(wb1).Sheets(1).Cells(3, "c").Value
Cells(n, 11) = GetObject(wb1).Sheets(1).Cells(3, "o").Value
Cells(n, 12) = GetObject(wb1).Sheets(1).Cells(3, "s").Value
Cells(n, 13) = GetObject(wb1).Sheets(1).Cells(3, "g").Value
Cells(n, 14) = GetObject(wb1).Sheets(1).Cells(3, "k").Value
Cells(n, 15) = GetObject(wb1).Sheets(1).Cells(3, "w").Value
Cells(n, 16) = GetObject(wb1).Sheets(1).Cells(4, "c").Value
Cells(n, 17) = GetObject(wb1).Sheets(1).Cells(4, "g").Value
Cells(n, 18) = GetObject(wb1).Sheets(1).Cells(4, "k").Value
Cells(n, 19) = GetObject(wb1).Sheets(1).Cells(4, "o").Value
Cells(n, 20) = GetObject(wb1).Sheets(1).Cells(4, "s").Value
Cells(n, 21) = GetObject(wb1).Sheets(1).Cells(4, "w").Value
Cells(n, 22) = GetObject(wb1).Sheets(1).Cells(5, "c").Value
Cells(n, 23) = GetObject(wb1).Sheets(1).Cells(5, "g").Value
Cells(n, 24) = GetObject(wb1).Sheets(1).Cells(5, "k").Value
Cells(n, 25) = GetObject(wb1).Sheets(1).Cells(5, "o").Value
Cells(n, 26) = GetObject(wb1).Sheets(1).Cells(3, "aa").Value
Cells(n, 27) = GetObject(wb1).Sheets(1).Cells(5, "w").Value
Cells(n, 28) = GetObject(wb1).Sheets(1).Cells(5, "aa").Value
Cells(n, 29) = GetObject(wb1).Sheets(1).Cells(4, "aa").Value
GetObject(wb1).Close False
Else

End If
      
   Next
   Next
Application.ScreenUpdating = True
End Sub

zopey

１、循环＋判断　语句
２、赋值到数组，再输出到工作表