VBA代码故障排查：Evaluation工作表计数功能失效问题

咱们先来拆解原代码里导致计数失效的几个核心问题，再给出修复后的版本：

原代码的关键问题 #

• 工作表名称不匹配：你提到的是Evaluation工作表，但代码里写了Worksheets("FC_SCR Evaluation")，这会直接导致找不到目标数据源，中断整个计数逻辑
• 变量声明不规范：Dim cntU, CntS, cntT As Integer里只有cntT是Integer类型，cntU和CntS默认是Variant类型，可能引发隐性类型错误
• 行号获取逻辑缺陷：Range("A5").End(xlDown).Row如果A5下方存在空行，会直接跳到工作表最后一行，导致统计范围错误；WorksheetFunction.CountA(Columns(23))的范围判断也不合理
• 循环逻辑漏洞：第一个循环找到当前周就Exit For，但如果Result表中没有当前周的记录，i会超出有效范围，后续赋值操作全部失效；而且计数循环里每次迭代都写入单元格，不仅效率低还可能覆盖正确结果
• 除零风险：计算比例时没有判断n是否为0，会触发运行时错误

修复后的完整代码 #

Sub result()
    Dim i As Integer
    Dim j As Long ' 用Long避免行号超出Integer的范围限制
    Dim cntU As Integer, cntS As Integer, cntT As Integer ' 明确每个变量的类型
    Dim shtResult As Worksheet
    Dim shtEval As Worksheet
    Dim totalRowsEval As Long
    Dim currentWeek As Integer
    Dim n As Long
    
    ' 提前绑定工作表，避免使用Select操作（更稳定高效）
    Set shtResult = ThisWorkbook.Sheets("Result")
    Set shtEval = ThisWorkbook.Sheets("Evaluation") ' 修正工作表名称，匹配你的需求
    
    currentWeek = Val(Format(Now, "WW")) ' 单独存储当前周数，减少重复计算
    
    ' 获取Evaluation表A列的有效行数（从A5开始统计）
    totalRowsEval = shtEval.Cells(shtEval.Rows.Count, "A").End(xlUp).Row
    If totalRowsEval < 5 Then ' 如果A5以下没有有效数据，直接退出并提示
        MsgBox "Evaluation表A5以下无有效数据！"
        Exit Sub
    End If
    
    ' 统计A列非空单元格的数量（从A5开始）
    n = shtEval.Range("A5:A" & totalRowsEval).SpecialCells(xlCellTypeConstants).Count
    
    ' 查找Result表中对应当前周的行，若不存在则自动新增一行
    i = 2 ' 从第2行开始查找
    Do While shtResult.Range("A" & i).Value <> ""
        If shtResult.Range("A" & i).Value = currentWeek Then
            Exit Do ' 找到匹配行，退出循环
        End If
        i = i + 1
    Loop
    ' 如果循环结束后未找到匹配行，自动在当前行写入周数
    If shtResult.Range("A" & i).Value <> currentWeek Then
        shtResult.Range("A" & i).Value = currentWeek
    End If
    
    ' 初始化计数器
    cntT = 0
    cntU = 0
    cntS = 0
    
    ' 遍历Evaluation表的目标行（从第5行到有效数据行）
    For j = 5 To totalRowsEval
        ' 先判断周数是否匹配，避免重复判断提升效率
        If shtEval.Range("X" & j).Value = currentWeek Then
            If shtEval.Range("T" & j).Value = "OK" Then cntT = cntT + 1
            If shtEval.Range("S" & j).Value = "OK" Then cntU = cntU + 1
            If shtEval.Range("R" & j).Value = "Invalid" Then cntS = cntS + 1
        End If
    Next j
    
    ' 一次性写入统计结果到Result表（减少工作表操作次数，提升效率）
    shtResult.Range("B" & i).Value = n
    shtResult.Range("C" & i).Value = cntS
    shtResult.Range("D" & i).Value = cntT
    shtResult.Range("E" & i).Value = cntU
    
    ' 计算比例时先判断n是否为0，避免除零错误
    If n > 0 Then
        shtResult.Range("F" & i).Value = cntS / n
        shtResult.Range("G" & i).Value = cntT / n
        shtResult.Range("H" & i).Value = cntU / n
    Else
        ' n为0时清空比例列，并给出提示
        shtResult.Range("F" & i & ":H" & i).ClearContents
        MsgBox "Evaluation表A列无有效数据，无法计算比例！"
    End If
End Sub

关键修改说明 #

1. 绑定工作表：直接用Set绑定目标工作表，避免Select操作，代码更稳定且执行速度更快
2. 修正工作表名称：把代码里的FC_SCR Evaluation改成你提到的Evaluation，确保能正确读取数据源
3. 准确获取有效行数：用Cells(Rows.Count, "A").End(xlUp).Row获取A列最后一行有效数据，避免空行导致的统计范围错误
4. 优化周数查找逻辑：用Do循环查找当前周的行，若不存在则自动新增一行，彻底解决找不到行导致的赋值失败问题
5. 规范变量声明：明确每个变量的类型，避免Variant类型带来的潜在问题
6. 一次性写入结果：循环计数完成后再批量写入单元格，减少对工作表的操作次数，提升代码效率
7. 增加错误处理：判断n是否为0避免除零错误，提前检查数据源是否为空并给出提示

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