Excel VBA逐行检测并分类统计FTGap与普通空白间隔

需求规则 #

需要通过VBA逐行检测工作表中值为"0"的连续单元格段（即间隔Gap），计数规则如下：

• 两类间隔独立计数：起始单元格对应第2行表头为周五、持续至周四的连续0值段定义为FTGap，单独累计数量；其余日期起始的连续0值段为普通Gap，单独累计数量。
• 同一行内若0值段被非"0"单元格分隔，需判定为多个独立间隔分别计数。
• 参考校验标准：首行统计结果为1个FTGap、1个普通Gap；第二行统计结果为1个FTGap；存在前置独立0值段的行统计结果为2个普通Gap、1个FTGap。

原有未达预期的代码 #

原有代码分为主遍历逻辑、EndGap统计子过程两部分，如下：

主遍历逻辑 #

For Row = 3 To Worksheets("Kalender2").UsedRange.Rows.Count
GapDays = 0
FTGapDays = 0

For col = 2 To 55 'Worksheets("Kalender2").Cells(2, Columns.Count).End(xlToLeft).Column
    If Worksheets("Kalender2").Cells(Row, col) = "0" And _
    Worksheets("Kalender2").Cells(2, col).Value = "Friday" Then
        
            FTGapDays = FTGapDays + 1
            
        ElseIf Worksheets("Kalender2").Cells(Row, col) = "0" And _
   FTGapDays <> 0 Then
            FTGapDays = FTGapDays + 1  'doortellen gap startend op vrijdag
            
        ElseIf Worksheets("Kalender2").Cells(Row, col) = "0" And _
 FTGapDays = 0 Then 'And Worksheets("Kalender2").Cells(2, Col).Value <> "Friday"  Then
            GapDays = GapDays + 1   'eerste lege cel andere dag dan vrijdag
           
    End If
Next col

If col = 54 Then
    Call EndGap
End If

Call EndGap
Next Row

EndGap统计子过程 #

Sub Endgap()
If FTGapDays <> 0 Then
If FTGapDays < 7 Then
    If GapDays = 0 Then
        Gaps = Gaps + 1
    End If
ElseIf FTGapDays >= 7 And FTGapDays < 14 Then
    FTGaps = FTGaps + 1
    If GapDays = 0 Then
        Gaps = Gaps + 1
    End If
ElseIf FTGapDays >= 14 And FTGapDays < 21 Then
    FTGaps = FTGaps + 2
    If GapDays = 0 Then
        Gaps = Gaps + 1
    End If
ElseIf FTGapDays >= 21 And FTGapDays < 28 Then
    FTGaps = FTGaps + 3
    LegGaps = LegGaps + 1
    If GapDays = 0 Then
        Gaps = Gaps + 1
    End If
ElseIf FTGapDays >= 28 And FTGapDays < 35 Then
    FTGaps = FTGaps + 4
    LegGaps = LegGaps + 1
    If GapDays = 0 Then
        Gaps = Gaps + 1
    End If
ElseIf FTGapDays >= 35 And FTGapDay < 42 Then
    FTGaps = FTGaps + 5
    LegGaps = LegGaps + 1
    If GapDays = 0 Then
        Gaps = Gaps + 1
    End If
ElseIf FTGapDays = 42 Then
    FTGaps = FTGaps + 6
    LegGaps = LegGaps + 2
End If

End If

End Sub

原有代码核心问题 #

• 遇到非0单元格时没有触发段结束结算逻辑，会把被非0值分隔的多个0段错误合并计数
• 变量作用域错误，GapDays/FTGapDays/Gaps/FTGaps/LegGaps等计数变量没有正确在过程间传递，子过程无法正确读取主逻辑的实时值
• 段起始判定逻辑错误：只要在周五列碰到0就直接计入FTGap，没有判断当前是否处于普通Gap段中，会把普通Gap中覆盖到周五列的部分错误算成FTGap
• 存在拼写错误：子过程中FTGapDay少写末尾的s，会触发变量未定义的运行错误
• 行遍历结束后没有结算普通Gap的逻辑，行尾的普通Gap会被漏统计
• 硬编码列范围为2到55，没有适配实际表头的动态列数，扩展性差

修正后可直接运行的代码 #

' 声明模块级统计变量，保证主逻辑和子过程可正常读写
Dim Gaps As Long, FTGaps As Long, LegGaps As Long
Sub CountAllGaps()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim iRow As Long, iCol As Long
    Dim GapDays As Long, FTGapDays As Long
    Dim inGap As Boolean, isFTGap As Boolean
    Dim currentHeader As String
    
    ' 初始化统计值
    Gaps = 0: FTGaps = 0: LegGaps = 0
    Set ws = ThisWorkbook.Worksheets("Kalender2")
    lastRow = ws.UsedRange.Rows.Count
    ' 动态获取表头最后一列，替代硬编码值
    lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    
    For iRow = 3 To lastRow
        ' 每行开始重置段状态
        GapDays = 0: FTGapDays = 0
        inGap = False: isFTGap = False
        
        For iCol = 2 To lastCol
            currentHeader = ws.Cells(2, iCol).Value
            If ws.Cells(iRow, iCol).Value = "0" Then
                If Not inGap Then
                    ' 新0段开始，根据起始列表头判定段类型
                    inGap = True
                    If currentHeader = "Friday" Then
                        isFTGap = True
                        FTGapDays = 1
                    Else
                        isFTGap = False
                        GapDays = 1
                    End If
                Else
                    ' 0段持续，累加对应类型的天数
                    If isFTGap Then
                        FTGapDays = FTGapDays + 1
                    Else
                        GapDays = GapDays + 1
                    End If
                End If
            Else
                ' 碰到非0值，立即结算当前已形成的0段
                If inGap Then
                    Call EndGap(GapDays, FTGapDays, isFTGap)
                    ' 重置段状态等待下一个0段
                    inGap = False: isFTGap = False
                    GapDays = 0: FTGapDays = 0
                End If
            End If
        Next iCol
        
        ' 行遍历结束，结算行尾未被非0值截断的0段
        If inGap Then
            Call EndGap(GapDays, FTGapDays, isFTGap)
        End If
    Next iRow
    
    ' 结果输出，可根据需要修改输出位置
    MsgBox "普通Gap数量：" & Gaps & vbCrLf & "FTGap数量：" & FTGaps & vbCrLf & "长间隔数量：" & LegGaps
End Sub

' 子过程通过传参接收段数据，避免作用域错误
Sub EndGap(ByRef GapDays As Long, ByRef FTGapDays As Long, ByVal isFTGap As Boolean)
    If isFTGap Then
        ' 按FTGap分段规则计数
        If FTGapDays < 7 Then
            Gaps = Gaps + 1
        ElseIf FTGapDays >= 7 And FTGapDays < 14 Then
            FTGaps = FTGaps + 1
            Gaps = Gaps + 1
        ElseIf FTGapDays >= 14 And FTGapDays < 21 Then
            FTGaps = FTGaps + 2
            Gaps = Gaps + 1
        ElseIf FTGapDays >= 21 And FTGapDays < 28 Then
            FTGaps = FTGaps + 3
            LegGaps = LegGaps + 1
            Gaps = Gaps + 1
        ElseIf FTGapDays >= 28 And FTGapDays < 35 Then
            FTGaps = FTGaps + 4
            LegGaps = LegGaps + 1
            Gaps = Gaps + 1
        ElseIf FTGapDays >= 35 And FTGapDays < 42 Then
            FTGaps = FTGaps + 5
            LegGaps = LegGaps + 1
            Gaps = Gaps + 1
        ElseIf FTGapDays = 42 Then
            FTGaps = FTGaps + 6
            LegGaps = LegGaps + 2
        End If
    Else
        ' 普通Gap直接计数
        If GapDays > 0 Then Gaps = Gaps + 1
    End If
End Sub

修正后逻辑严格遵循段分隔规则，每碰到非0值就结算当前连续0段，不会出现跨非0值合并计数的问题；FTGap判定仅以段起始单元格的表头是否为周五为准，不会误判段中包含周五的普通Gap；变量全部通过传参或模块级声明传递，不会出现值读取错误的问题。

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