search文件夹以将每个文件匹配到表格

我添加了一个For循环（见k部分），它确实减慢了我的整个程序。 有没有可能让这个效率更高？

我正在search特定的文件夹，并试图将每个文件与我的电子表格中的表格进行匹配。 我正在尝试使Quarters（1，j）在代码的下半部分与Quarters（i，j）相同，但不知道该怎么做，因为我已经使用了整数i。

For j = 1 To 2 For k = 1 To 39 If k <= 29 Then 'Looks at all the files in the folder for the given Quarter SourceFolderName = FolderPath & "\" & Quarters(1, j) Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(SourceFolderName) End If If k > 29 Then SourceFolderName = FolderPath & "\" & Quarters(k, j) Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(SourceFolderName) End If For Each objFile In objFolder.Files i = 1 NotAssigned = True 'Keep going until we match the file While NotAssigned = True 'If the beginning of the file name matches for a given state, 'assign the file name to that state for this quarter If Left(objFile.Name, 9) = StateAbbr(i, 1) & Quarters(i, j) & "FA" Then WBName(i, j) = objFile.Name 'Stop trying to match the file NotAssigned = False End If If i = 39 Then NotAssigned = False i = i + 1 Wend Next objFile Set objFile = Nothing Set objFolder = Nothing Set objFSO = Nothing Next k Next j 

Answer 1

我设法改变我的整个代码使用DIR，而不是循环电子表格中的每个单元格，并循环我的文件夹中的每个文件。 我的运行时间从40分钟减less到2秒!!!!!!! 现在我很惊讶。 如果你有兴趣，这里是解决scheme。

 Dim StrFile As String For j = 1 To 2 For i = 1 To 39 StrFile = Dir(FolderPath & "\" & Quarters(i, j) & "\*FA*") Do While Len(StrFile) > 0 If Left(StrFile, 9) = StateAbbr(i, 1) & Quarters(i, j) & "FA" Then WBName(i, j) = StrFile End If StrFile = Dir Loop Next i Next j