VBA读取关闭工作簿数据：循环升序顺序不符问题求助

你猜的没错——不是Excel故意"搞事情"，而是文件系统（不管是Windows还是其他系统）对文件名的排序是按字符串字典序来的，不是我们直觉里的数字顺序。

举个例子：当文件系统看到"1.xlsx"和"10.xlsx"时，它会把它们当成字符串比较：第一个字符"1"和"1"相同，第二个字符（"10"的第二个是"0"）比"2.xlsx"的第一个字符"2"小，所以"10"会排在"2"前面，就导致你看到的顺序乱掉了。

解决方法有两种，看你需求选： #

方法一：直接按数字顺序生成文件名（最推荐，简单高效）

既然你已经知道文件名是1到80，完全不需要遍历文件夹找文件——直接从1到80循环，手动拼接文件名，按顺序读取就行，彻底绕开排序问题。

代码示例：

Sub ReadF7InOrder()
    Dim i As Integer
    Dim targetFilePath As String
    Dim sourceWB As Workbook
    Dim outputCell As Range
    
    ' 设置结果要存的位置，比如当前工作表的A1单元格
    Set outputCell = ThisWorkbook.ActiveSheet.Range("A1")
    
    ' 从1到80按数字顺序循环
    For i = 1 To 80
        ' 拼接文件路径（假设所有文件和当前工作簿在同一个文件夹）
        targetFilePath = ThisWorkbook.Path & "\" & i & ".xlsx"
        
        ' 先检查文件是否存在，避免报错
        If Dir(targetFilePath) <> "" Then
            ' 以只读模式打开文件，避免锁定
            Set sourceWB = Workbooks.Open(targetFilePath, ReadOnly:=True)
            ' 读取F7的值到结果单元格
            outputCell.Value = sourceWB.Sheets(1).Range("F7").Value
            ' 关闭文件，不保存任何更改
            sourceWB.Close SaveChanges:=False
        Else
            ' 如果文件不存在，标记提示
            outputCell.Value = "文件 " & i & ".xlsx 未找到"
        End If
        
        ' 移动到下一个结果单元格
        Set outputCell = outputCell.Offset(1, 0)
    Next i
    
    MsgBox "数据读取完成！"
End Sub

方法二：先收集文件再按数字排序（适合文件可能不全的情况）

如果文件夹里的文件可能不是连续的1-80（比如缺了某些编号），那可以先把所有符合条件的文件收集起来，提取文件名里的数字，排序后再处理：

Sub ReadSortedFiles()
    Dim fso As Object
    Dim targetFolder As Object
    Dim file As Object
    Dim sortedFilePaths As Collection
    Dim fileNumber As Integer
    Dim i As Integer
    Dim outputCell As Range
    
    ' 初始化文件系统对象和集合
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set targetFolder = fso.GetFolder(ThisWorkbook.Path) ' 替换成你的文件夹路径
    Set sortedFilePaths = New Collection
    Set outputCell = ThisWorkbook.ActiveSheet.Range("A1")
    
    ' 遍历文件夹，收集1-80的文件
    For Each file In targetFolder.Files
        ' 只处理xlsx文件，且文件名是数字
        If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then
            fileNumber = Val(fso.GetBaseName(file.Name))
            ' 筛选1到80之间的文件
            If fileNumber >= 1 And fileNumber <= 80 Then
                ' 用数字作为键，确保集合里的顺序是按数字来的
                On Error Resume Next
                sortedFilePaths.Add file.Path, Key:=CStr(fileNumber)
                On Error GoTo 0
            End If
        End If
    Next file
    
    ' 按数字顺序读取每个文件
    For i = 1 To 80
        On Error Resume Next
        Dim filePath As String
        filePath = sortedFilePaths(CStr(i))
        If Err.Number = 0 Then
            Set sourceWB = Workbooks.Open(filePath, ReadOnly:=True)
            outputCell.Value = sourceWB.Sheets(1).Range("F7").Value
            sourceWB.Close SaveChanges:=False
        Else
            outputCell.Value = "文件 " & i & ".xlsx 未找到"
        End If
        On Error GoTo 0
        
        Set outputCell = outputCell.Offset(1, 0)
    Next i
    
    MsgBox "数据读取完成！"
End Sub

小提示 #

第一种方法更省心，因为你已经明确知道文件名的范围，直接循环数字就好，不需要处理文件排序的问题。如果有文件缺失，代码也会帮你标记出来，非常直观。

内容的提问来源于stack exchange，提问作者PeterLAU