使用VBA遍历Excel文件夹提取指定单元格数据出现布尔值异常

问题根源 #

1. 错误的赋值逻辑：代码里的赋值语句用了双重等号（= Region），这是在做比较运算，返回的是布尔值（TRUE/FALSE），而不是把目标单元格的值写入主文件。比如Cells(y, 1) = ws.Cells(x,1).Value = Region，实际是判断ws.Cells(x,1).Value是否等于Region，把判断结果存到主单元格里。
2. 目标单元格引用错误：原需求要提取A2（Region）、B3（DateSales）、C5（Sales）、D6（Salesman），但代码里写的是Sheets(1).Cells(1,2)（对应B1）、Cells(2,3)（对应C2）等，位置完全不符合需求。
3. 多余的循环嵌套：原需求是每个文件的指定工作表提取一组数据，不需要遍历文件内的所有工作表，也不需要遍历每行，原代码的For Each ws和For x=2 To wsLR会导致重复写入大量无效数据。

修复后的完整代码 #

Sub getDataFromWbs()
    Dim wb As Workbook, wsTarget As Worksheet
    Dim Region As String
    Dim DateSales As Date
    Dim Sales As Integer
    Dim Salesman As String
    Dim fso As Object, fldr As Object, wbFile As Object
    Dim nextRow As Long
    
    ' 关闭屏幕刷新，提升运行速度
    Application.ScreenUpdating = False
    
    ' 初始化文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 指定目标文件夹路径，自行修改
    Set fldr = fso.GetFolder("C:\Users\xxxxx\yyyyyy\Desktop\Sales\")
    
    ' 获取主文件Sheet1的下一个空行
    nextRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    ' 遍历文件夹内的所有文件
    For Each wbFile In fldr.Files
        ' 只处理xlsx格式的Excel文件
        If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
            ' 打开目标文件（只读模式避免锁定原文件）
            Set wb = Workbooks.Open(wbFile.Path, ReadOnly:=True)
            ' 指定要提取数据的工作表，替换为你实际需要的表名
            Set wsTarget = wb.Sheets("Sheet1")
            
            ' 按需求提取目标单元格数据
            Region = wsTarget.Range("A2").Value
            DateSales = wsTarget.Range("B3").Value
            Sales = wsTarget.Range("C5").Value
            Salesman = wsTarget.Range("D6").Value
            
            ' 将数据写入主文件对应列
            ThisWorkbook.Sheets("Sheet1").Cells(nextRow, 1).Value = Region
            ThisWorkbook.Sheets("Sheet1").Cells(nextRow, 2).Value = DateSales
            ThisWorkbook.Sheets("Sheet1").Cells(nextRow, 3).Value = Sales
            ThisWorkbook.Sheets("Sheet1").Cells(nextRow, 4).Value = Salesman
            
            ' 切换到下一行准备写入下一组数据
            nextRow = nextRow + 1
            
            ' 关闭文件，不保存修改
            wb.Close SaveChanges:=False
        End If
    Next wbFile
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    MsgBox "数据提取完成！"
End Sub

关键修改说明 #

• 修正赋值逻辑：把双重等号的比较语句改成直接赋值，比如Cells(nextRow, 1).Value = Region，直接将提取到的Region值写入主单元格。
• 修正单元格引用：按照需求用Range("A2")或Cells(2,1)准确引用目标单元格。
• 移除多余循环：只处理指定工作表，每个Excel文件只写入一行数据，避免无效重复。
• 新增只读打开：防止打开文件时锁定原文件，不影响其他用户访问。
• 优化变量命名：把y改成nextRow，提升代码可读性。

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