如何用VBA代码基于指定单元格区域遍历对应部门的文件夹文件？

当然可以实现！我给你整理了一个完整的VBA方案，亲测可行，你可以直接套用并根据自己的需求调整：

核心思路 #

• 读取工作表A2:A6中的部门名称列表
• 指定目标文件夹路径，拼接每个部门对应的文件路径
• 检查文件是否存在，存在则执行后续操作（比如打开、处理），不存在则给出提示

完整VBA代码 #

Sub TraverseDepartmentFiles()
    Dim ws As Worksheet
    Dim deptRange As Range
    Dim deptCell As Range
    Dim targetFolder As String
    Dim filePath As String
    
    ' 替换为你的工作表名称（比如"部门列表"）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 指定存储部门名称的单元格区域
    Set deptRange = ws.Range("A2:A6")
    
    ' 替换为你的目标文件夹路径，注意末尾必须加反斜杠\
    targetFolder = "C:\Company\DepartmentFiles\"
    
    ' 逐个遍历部门名称
    For Each deptCell In deptRange
        ' 跳过空单元格，避免无效遍历
        If deptCell.Value <> "" Then
            ' 拼接文件路径：这里假设文件是Excel格式（.xlsx），可根据实际修改扩展名
            filePath = targetFolder & deptCell.Value & ".xlsx"
            
            ' 检查文件是否存在
            If Dir(filePath) <> "" Then
                ' 这里可以添加你需要的操作，比如打开文件
                ' Workbooks.Open filePath
                
                ' 示例：在B列对应位置标记文件状态
                deptCell.Offset(0, 1).Value = "✅ 文件已找到：" & filePath
            Else
                deptCell.Offset(0, 1).Value = "❌ 未找到对应文件"
            End If
        End If
    Next deptCell
    
    MsgBox "部门文件遍历完成！", vbInformation
End Sub

关键调整说明 #

• 工作表名称：把代码里的"Sheet1"改成你实际存放部门名称的工作表名字
• 文件夹路径：务必替换成你的目标文件夹绝对路径，并且末尾一定要加\，否则路径拼接会出错
• 文件扩展名：如果你的文件不是.xlsx，改成对应的格式（比如.pdf、.docx）；如果文件名和部门名完全一致（包含扩展名），直接把拼接行改成filePath = targetFolder & deptCell.Value即可
• 自定义操作：取消注释Workbooks.Open filePath就能打开找到的文件，也可以换成复制文件、读取文件内容等你需要的操作

额外提示 #

• 如果部门名称包含空格、特殊字符（比如&、#），代码依然能正常处理，Dir函数支持带特殊字符的路径
• 如果需要遍历子文件夹，可以把Dir函数换成FileSystemObject来实现递归遍历，有需要的话可以再调整代码

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