求Excel Macro代码：批量读取文件夹文件并实现Countif统计

安全阿岳

2026-5-15

嘿，我正好处理过类似的多工作簿统计需求，给你一份基础的Excel VBA宏代码，直接就能用，我会把关键部分讲明白，方便你根据实际情况调整。

多工作簿箱子物品统计VBA宏代码

Sub 统计多工作簿箱子物品数量()
    Dim 目标文件夹 As String
    Dim 当前文件 As String
    Dim 源工作簿 As Workbook
    Dim 源工作表 As Worksheet
    Dim 统计字典 As Object
    Dim 当前行 As Long
    Dim 最后行 As Long
    Dim 箱子名称 As String
    Dim 物品名称 As String
    Dim 结果工作表 As Worksheet
    Dim 结果行 As Long
    Dim 字典键 As String
    
    ' --------------------------
    ' 请修改这里的文件夹路径和列设置
    ' --------------------------
    目标文件夹 = "C:\你的文件夹路径\" ' 替换成你的Excel文件所在文件夹
    Dim 箱子列 As String: 箱子列 = "A" ' 箱子名称所在列
    Dim 物品列 As String: 物品列 = "B" ' 物品信息所在列
    ' --------------------------
    
    ' 创建统计用的字典（用来存箱子+物品的唯一组合及数量）
    Set 统计字典 = CreateObject("Scripting.Dictionary")
    
    ' 创建结果工作表
    On Error Resume Next
    Set 结果工作表 = ThisWorkbook.Worksheets("统计结果")
    If Err.Number <> 0 Then
        Set 结果工作表 = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        结果工作表.Name = "统计结果"
    End If
    On Error GoTo 0
    
    ' 清空结果表旧数据（保留表头）
    结果工作表.Cells.Clear
    结果工作表.Range("A1:C1") = Array("箱子名称", "物品名称", "数量")
    结果行 = 2
    
    ' 遍历文件夹里的所有Excel文件
    当前文件 = Dir(目标文件夹 & "*.xlsx")
    Do While 当前文件 <> ""
        ' 打开源工作簿（只读模式，避免锁定）
        Set 源工作簿 = Workbooks.Open(Filename:=目标文件夹 & 当前文件, ReadOnly:=True)
        ' 默认取第一个工作表，如果你需要指定工作表名称，可以改成Sheets("你的表名")
        Set 源工作表 = 源工作簿.Worksheets(1)
        
        ' 获取源表最后一行
        最后行 = 源工作表.Cells(源工作表.Rows.Count, 箱子列).End(xlUp).Row
        
        ' 从第二行开始读取数据（跳过表头）
        For 当前行 = 2 To 最后行
            箱子名称 = Trim(源工作表.Range(箱子列 & 当前行).Value)
            物品名称 = Trim(源工作表.Range(物品列 & 当前行).Value)
            
            ' 跳过空值
            If 箱子名称 <> "" And 物品名称 <> "" Then
                字典键 = 箱子名称 & "|" & 物品名称 ' 用分隔符区分箱子和物品，避免重名冲突
                If 统计字典.Exists(字典键) Then
                    ' 如果已存在，数量+1
                    统计字典(字典键) = 统计字典(字典键) + 1
                Else
                    ' 如果不存在，添加新条目，数量设为1
                    统计字典(字典键) = 1
                End If
            End If
        Next 当前行
        
        ' 关闭源工作簿，不保存
        源工作簿.Close SaveChanges:=False
        ' 取下一个文件
        当前文件 = Dir()
    Loop
    
    ' 将字典里的统计结果写入结果表
    For Each 字典键 In 统计字典.Keys
        ' 拆分键，得到箱子和物品名称
        箱子名称 = Split(字典键, "|")(0)
        物品名称 = Split(字典键, "|")(1)
        ' 写入数据
        结果工作表.Range("A" & 结果行).Value = 箱子名称
        结果工作表.Range("B" & 结果行).Value = 物品名称
        结果工作表.Range("C" & 结果行).Value = 统计字典(字典键)
        结果行 = 结果行 + 1
    Next 字典键
    
    ' 给结果表列自动调整宽度
    结果工作表.Columns("A:C").AutoFit
    
    MsgBox "统计完成！结果已保存到「统计结果」工作表。", vbInformation
End Sub

使用说明

修改文件夹路径：把代码里的"C:\你的文件夹路径\"替换成你存放Excel文件的实际文件夹路径，注意路径末尾要加反斜杠\。
调整列设置：如果你的箱子名称不在A列、物品不在B列，修改箱子列和物品列的值就行，比如箱子在C列就改成箱子列 = "C"。
指定工作表：代码默认读取每个工作簿的第一个工作表，如果需要指定特定名称的工作表，把Set 源工作表 = 源工作簿.Worksheets(1)改成Set 源工作表 = 源工作簿.Worksheets("你的工作表名称")。
运行宏：打开一个新的空白Excel文件，按Alt+F11打开VBA编辑器，插入一个新模块，把代码粘贴进去，然后运行这个宏就行。

关键功能说明

用Scripting.Dictionary实现类似COUNTIF的统计，自动去重并累计数量，比循环判断效率高很多。
以箱子名称|物品名称作为字典的键，避免不同箱子里的同一种物品被错误合并统计。
所有源工作簿都以只读模式打开，不会修改原文件，也不会因为文件被占用而报错。
自动创建「统计结果」工作表，旧数据会被清空，最后自动调整列宽，让报表更整洁。

如果运行过程中遇到问题，比如文件夹里有非Excel文件，或者某个文件格式不对，你可以在代码里加个错误捕获，不过这个基础版本已经能覆盖大部分常规场景啦。

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