如何优化VBA多条件计数循环？避免重复代码求助

我明白你现在的痛点——一堆结构几乎一模一样的循环，就只是判断条件不一样，写起来既繁琐又难维护。你之前尝试用函数封装，但因为条件提前求值导致失败，核心问题就是你把针对单个工作表的判断提前计算好了，而不是让它在循环每个工作表时动态执行。

下面给你两种实用的解决方案，从简单到优雅，按需选择：

方法一：用函数名传递实现动态判断（快速上手） #

这种方法不需要复杂的类，只需要把每个判断逻辑封装成独立的函数，然后写一个通用的计数函数，通过函数名来调用对应的判断逻辑。

步骤1：定义判断函数 #

先把你每个不同的判断条件写成单独的函数，每个函数接受一个Worksheet对象作为参数，返回Boolean值：

' 判断工作表A1单元格是否为空
Function IsSheetA1Empty(ws As Worksheet) As Boolean
    IsSheetA1Empty = IsEmpty(ws.Cells(1, 1))
End Function

' 判断工作表C3:E5区域是否有数据
Function HasDataInC3E5(ws As Worksheet) As Boolean
    HasDataInC3E5 = Application.CountA(ws.Range("$C$3:$E$5")) > 0
End Function

步骤2：写通用计数函数 #

这个函数负责循环20个工作表，每次调用你传入的判断函数：

Function CountWorksheetsByCriteria(book As Workbook, criteriaFuncName As String) As Long
    Dim count As Long
    Dim i As Long
    Dim targetWs As Worksheet
    
    count = 0
    For i = 1 To 20
        Set targetWs = book.Worksheets("WorksheetNumber" & i)
        ' 动态调用判断函数，传入当前工作表
        If Application.Run(criteriaFuncName, targetWs) Then
            count = count + 1
        End If
    Next i
    
    CountWorksheetsByCriteria = count
End Function

步骤3：调用通用函数 #

现在你只需要一行代码就能完成统计：

Sub TestCount()
    Dim targetWorkbook As Workbook
    Set targetWorkbook = ThisWorkbook ' 替换成你的目标工作簿
    
    ' 统计A1为空的工作表数量
    MsgBox CountWorksheetsByCriteria(targetWorkbook, "IsSheetA1Empty")
    
    ' 统计C3:E5有数据的工作表数量
    MsgBox CountWorksheetsByCriteria(targetWorkbook, "HasDataInC3E5")
End Sub

方法二：用类模块实现回调（优雅扩展） #

如果你的判断条件会越来越复杂，或者需要更灵活的扩展，用面向对象的方式会更易维护。

步骤1：创建抽象判断类 #

插入一个类模块，命名为WorksheetCriteria，里面定义一个抽象的匹配方法：

' 抽象类：定义判断规则的接口
Public Function IsMatch(ws As Worksheet) As Boolean
    ' 这里不需要写逻辑，由具体的子类实现
End Function

步骤2：创建具体的判断类 #

再插入两个类模块，分别实现不同的判断逻辑：

第一个类命名为SheetA1EmptyCriteria：

Implements WorksheetCriteria

' 实现抽象类的IsMatch方法
Public Function WorksheetCriteria_IsMatch(ws As Worksheet) As Boolean
    WorksheetCriteria_IsMatch = IsEmpty(ws.Cells(1, 1))
End Function

第二个类命名为SheetC3E5HasDataCriteria：

Implements WorksheetCriteria

' 实现抽象类的IsMatch方法
Public Function WorksheetCriteria_IsMatch(ws As Worksheet) As Boolean
    WorksheetCriteria_IsMatch = Application.CountA(ws.Range("$C$3:$E$5")) > 0
End Function

步骤3：写通用计数函数（面向对象版） #

Function CountWorksheetsByCriteriaObj(book As Workbook, criteria As WorksheetCriteria) As Long
    Dim count As Long
    Dim i As Long
    Dim targetWs As Worksheet
    
    count = 0
    For i = 1 To 20
        Set targetWs = book.Worksheets("WorksheetNumber" & i)
        If criteria.IsMatch(targetWs) Then
            count = count + 1
        End If
    Next i
    
    CountWorksheetsByCriteriaObj = count
End Function

步骤4：调用面向对象的通用函数 #

Sub TestCountWithClass()
    Dim targetWorkbook As Workbook
    Dim criteriaA As SheetA1EmptyCriteria
    Dim criteriaB As SheetC3E5HasDataCriteria
    
    Set targetWorkbook = ThisWorkbook
    Set criteriaA = New SheetA1EmptyCriteria
    Set criteriaB = New SheetC3E5HasDataCriteria
    
    MsgBox CountWorksheetsByCriteriaObj(targetWorkbook, criteriaA)
    MsgBox CountWorksheetsByCriteriaObj(targetWorkbook, criteriaB)
End Sub

为什么你的原方法失败？ #

你之前的代码里，IsEmpty(Workbook1.Worksheets("WorksheetNumber" & i).Cells(1,1))在传入函数前就已经求值了——这时候i要么是未定义（导致下标越界），要么是某个固定值，所以函数循环20次都是在判断同一个工作表的条件，自然得不到正确结果。

搜索关键词推荐 #

如果想深入学习这类技巧，可以搜索这些关键词：

• VBA 回调函数
• VBA 函数作为参数
• VBA 面向对象 条件判断
• VBA 通用循环封装

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