如何修复货位锁定统计多计数1次的VBA代码？

我看你遇到了锁定货位计数偏多的问题——总计多了3次，每个分组都多1次，这大概率是代码里的判断逻辑和计数累加环节出了问题，下面一步步拆解并给出修复方案：

核心问题点 #

• 错误用统计函数判断单个单元格状态：你用Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true")来判断单个单元格是否为TRUE，这个函数返回1（当单元格为TRUE时），在VBA里非0值会被视为True，但更关键的是，这个写法在计数时容易导致重复累加。
• 条件判断逻辑漏洞：原代码里If bcSH.Range("E" & i).Value = 1 Or Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true") Then的Or条件有问题——只要G列是TRUE，不管E列是否符合要求，都会进入循环处理，这会导致部分行被重复统计。
• 新行初始化的冗余累加：添加新分组行时，你写了.Range("F" & b + 1) = binLockCell + .Range("F" & b + 1)，但新行的F列初始为空（默认值0），虽然看似结果正确，但结合前面的逻辑漏洞，会放大计数错误。

修复后的完整代码 #

Sub getBinStatusArray()
    calc (False)
    Dim dSH As Worksheet
    Dim brSH As Worksheet
    Dim bcSH As Worksheet
    Set dSH = ThisWorkbook.Sheets("data")
    Set brSH = ThisWorkbook.Sheets("Bin Report")
    Set bcSH = ThisWorkbook.Sheets("Bin Conversions")
    Dim binType As String, binSize As Variant, b As Long, i As Long
    Dim dataArray() As Variant
    Dim isLocked As Boolean ' 存储当前行是否锁定的状态
    Dim bcLastRow As Long, brLastRow As Long
    
    ' 读取data表数据（原代码的ReDim被后续赋值覆盖，可删除）
    With dSH
        brLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        dataArray = .Range(.Cells(1, 1), .Cells(brLastRow, .Columns.Count).End(xlToLeft)).Value
    End With
    
    ' 统计Bin Conversion中每个货位在data表的出现次数
    With bcSH
        bcLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To bcLastRow
            .Range("E" & i).Value2 = Application.WorksheetFunction.CountIf(dSH.Range("A:A"), .Range("A" & i).Value2)
        Next i
    End With
    
    ' 生成Bin Report报表
    With brSH
        .Cells.ClearContents
        ' 设置表头
        .Range("H1").Value = "Filter Input"
        .Range("B1,I1").Value = "Bin Type"
        .Range("C1,J1").Value = "Bin Height"
        .Range("D1,K1").Value = "Verified"
        .Range("E1,L1").Value = "Unverified"
        .Range("F1,M1").Value = "Bins Locked"
        
        For i = 2 To bcLastRow
            ' 直接判断当前行是否锁定，兼容布尔值和文本"true"的大小写
            isLocked = (UCase(bcSH.Range("G" & i).Value) = "TRUE")
            
            ' 修正条件：仅处理E列有值（>=1）或锁定的行，可根据业务调整
            If bcSH.Range("E" & i).Value >= 1 Or isLocked Then
                binType = bcSH.Range("B" & i).Value
                binSize = bcSH.Range("C" & i).Value
                Dim foundMatch As Boolean: foundMatch = False
                
                ' 查找已存在的分组
                brLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
                For b = 2 To brLastRow
                    If .Range("B" & b).Value = binType And .Range("C" & b).Value = binSize Then
                        ' 累加已验证计数
                        .Range("D" & b).Value = .Range("D" & b).Value + bcSH.Range("E" & i).Value
                        ' 仅当当前行锁定时，累加锁定计数
                        If isLocked Then .Range("F" & b).Value = .Range("F" & b).Value + 1
                        foundMatch = True
                        Exit For
                    End If
                Next b
                
                ' 未找到匹配则新增分组行
                If Not foundMatch Then
                    brLastRow = brLastRow + 1
                    .Range("B" & brLastRow).Value = binType
                    .Range("C" & brLastRow).Value = binSize
                    .Range("D" & brLastRow).Value = bcSH.Range("E" & i).Value
                    ' 直接设置锁定计数，避免冗余累加
                    .Range("F" & brLastRow).Value = IIf(isLocked, 1, 0)
                End If
            End If
        Next i
        
        ' 排序报表
        .Range("b1").CurrentRegion.Sort Key1:=.Range("b1"), Order1:=xlAscending, _
            Key2:=.Range("C1"), Order2:=xlAscending, Header:=xlYes
    End With
    calc (True)
End Sub

关键修复说明 #

1. 替换锁定状态判断方式：用isLocked = (UCase(bcSH.Range("G" & i).Value) = "TRUE")直接判断单元格状态，避免用统计函数处理单个单元格，减少错误概率。
2. 优化分组匹配逻辑：新增foundMatch变量，清晰区分“查找已有分组”和“新增分组”的流程，解决原代码中循环边界判断的漏洞。
3. 修正计数逻辑：只有当当前行确实为锁定状态时，才对锁定计数进行累加，避免无条件累加导致的重复计数。
4. 精简冗余代码：删除了被覆盖的数组初始化语句，提前存储工作表最后一行的数值，提升代码运行效率。

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