Excel VBA：如何在新增行的隔列添加复选框？

现有一段Excel VBA的Addrow子程序，功能是在工作表末尾新增一行、为指定连续列添加复选框，并对偶数序号行着色。现在需要修改为在新增行的每第二列（隔列）添加复选框，但尝试用Union或复合范围定义rngCel2时失效，单独选目标单元格也报错，试过隔列函数或计数器仍未解决，求可行方案。

原代码：

Sub Addrow()

    Dim rngCel2 As Range
    Dim ChkBx As CheckBox
    
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    EventNo = LastRow - 3
    
    NewEvent = EventNo + 1
    
    ActiveSheet.Cells(LastRow + 1, 1).Select
    ActiveCell.Value = NewEvent
    
    If NewEvent Mod 2 = 0 Then
        ActiveSheet.Range(ActiveCell, ActiveCell.Offset(0, 25)).Interior.Color = RGB(242, 242, 242)
    End If
    
    ActiveSheet.Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 23)).Select

    For Each rngCel2 In Selection
        With rngCel2.MergeArea.Cells
            If .Resize(1, 1).Address = rngCel2.Address Then
                Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
                With ChkBx
                    .Value = xlOff
                    .LinkedCell = rngCel2.MergeArea.Cells.Address
                    With .Border
                    End With
                End With
            End If
        End With
    Next rngCel2
    
    For Each ChkBx In ActiveSheet.CheckBoxes
        ChkBx.Caption = ""
    Next ChkBx

End Sub

直接通过列号步进循环实现隔列添加复选框，避免复杂范围合并操作，代码如下：

Sub Addrow()
    Dim rngCel2 As Range
    Dim ChkBx As CheckBox
    Dim LastRow As Long
    Dim EventNo As Long
    Dim NewEvent As Long
    Dim col As Long ' 新增列循环变量
    
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    EventNo = LastRow - 3
    NewEvent = EventNo + 1
    
    ' 写入新行序号并处理偶数行着色
    With ActiveSheet.Cells(LastRow + 1, 1)
        .Value = NewEvent
        If NewEvent Mod 2 = 0 Then
            ActiveSheet.Range(.Cells, .Offset(0, 25)).Interior.Color = RGB(242, 242, 242)
        End If
        
        ' 从第5列（E列）到第24列（X列），隔列循环添加复选框
        For col = 4 To 23 Step 2
            Set rngCel2 = .Offset(0, col)
            With rngCel2.MergeArea.Cells
                ' 仅在合并区域起始单元格添加复选框，避免重复
                If .Cells(1).Address = rngCel2.Address Then
                    Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
                    With ChkBx
                        .Value = xlOff
                        .LinkedCell = rngCel2.MergeArea.Cells.Address
                        .Caption = "" ' 直接清空标题，无需单独遍历
                    End With
                End If
            End With
        Next col
    End With
End Sub

关键修改说明 #

• 替换范围遍历为列步进循环：用For col = 4 To 23 Step 2直接指定隔列的列偏移量，彻底规避Union或复合范围的兼容性问题。
• 移除冗余的Select操作：直接通过单元格对象操作，减少报错概率，提升代码执行效率。
• 优化复选框标题设置：在添加复选框时直接清空标题，无需单独遍历所有复选框，节省系统资源。
• 简化合并区域判断：用.Cells(1).Address判断合并区域起始单元格，逻辑更清晰易懂。

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