Excel多工作表循环自定义函数(UDF)运行异常求助
跨工作表统计两值组合出现次数的VBA自定义函数
没问题,我帮你写一个完全适配需求的VBA自定义函数——它能自动遍历工作簿里的所有工作表,针对指定列统计你要的两个值组合的出现次数,后续维护和扩展都很省心,还兼顾了当前小数据量的高效性和未来数据增长的扩展性。
完整VBA代码
Function CountTwoValueAcrossSheets(value1 As Variant, value2 As Variant, targetCol As Integer) As Long Dim ws As Worksheet Dim tbl As ListObject Dim count As Long Dim targetRange As Range Dim arr As Variant Dim i As Long count = 0 ' 关闭屏幕更新提升效率(大数据量时更明显) Application.ScreenUpdating = False ' 遍历当前工作簿的所有工作表 For Each ws In ThisWorkbook.Worksheets ' 优先检查当前工作表是否有表格(ListObject) On Error Resume Next Set tbl = ws.ListObjects(1) ' 默认取第一个表格,若有多个可修改索引或名称 On Error GoTo 0 ' 确定要统计的目标范围 If Not tbl Is Nothing Then ' 有表格时,直接取表格目标列的数据区域 Set targetRange = tbl.ListColumns(targetCol).DataBodyRange Else ' 无表格时,取目标列的已使用区域 Set targetRange = ws.UsedRange.Columns(targetCol) End If ' 如果目标范围不为空,开始统计 If Not targetRange Is Nothing Then ' 把区域数据读入数组,提升遍历速度(大数据量必备) arr = targetRange.Value ' 遍历数组统计匹配项 For i = LBound(arr, 1) To UBound(arr, 1) ' --- 这里可以根据需求切换统计逻辑 --- ' 逻辑1:统计值等于value1 OR value2的总次数 If arr(i, 1) = value1 Or arr(i, 1) = value2 Then count = count + 1 End If ' 逻辑2:统计单元格同时包含value1 AND value2的次数(文本模糊匹配) ' If InStr(1, arr(i, 1), value1, vbTextCompare) > 0 And _ ' InStr(1, arr(i, 1), value2, vbTextCompare) > 0 Then ' count = count + 1 ' End If Next i End If ' 清空对象变量,避免内存泄漏 Set targetRange = Nothing Set tbl = Nothing Next ws ' 恢复屏幕更新 Application.ScreenUpdating = True ' 返回统计结果 CountTwoValueAcrossSheets = count End Function
关键细节说明
- 参数用法:
value1/value2:你要统计的两个目标值(支持文本、数字等任意数据类型)targetCol:指定统计的列号(比如A列填1,B列填2,以此类推)
- 表格适配:优先识别工作表中的表格(ListObject),完美匹配你“多数工作表有表格”的场景;没有表格的工作表会自动用该列的已使用区域,兼容性拉满
- 可切换的统计逻辑:代码里写了两种最常用的统计逻辑,你只要注释/取消注释对应代码块就能切换:
- 逻辑1:统计目标列中等于任意一个输入值的总次数(对应你给出的“Quality”和“Due Im...”的例子)
- 逻辑2:统计目标列中同时包含两个输入值的单元格次数(比如单元格内容是“Quality - Due Immediate”)
- 性能优化:用数组遍历替代单个单元格遍历,加上关闭屏幕更新,后续数据量增长时也能保持高效运行
如何使用
在Excel单元格里直接调用函数就行,举个例子:
=CountTwoValueAcrossSheets("Quality", "Due Im...", 3)
这个公式会统计当前工作簿所有工作表的第3列(C列)中,值为“Quality”或“Due Im...”的总次数。
内容的提问来源于stack exchange,提问作者David Mosher
相关产品推荐
相关产品推荐

