每隔一行添加复选框

问题描述 投票:0回答:1

下面是 Sub 的一部分,它将行添加到电子表格,包括每隔一列中的复选框。

每次我尝试使用联合或复杂范围时,它似乎不适用于我的 rngCel2 Dim 语句。
顶部部分不是值得关注的部分,但我添加它是为了上下文,以防万一它的某些部分产生干扰。

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

代码应该实现什么:
enter image description here

每个宏的使用(绑定到一个按钮)都应该在最后一行下面添加一行。目前还没有任何代码可以为复选框列重新着色。

我尝试单独选择所需的单元格。这会返回一个错误代码,因为该代码需要一个范围。
当我尝试 union 函数时,出现同样的问题。

我尝试找到“每隔一个单元格”功能或使用计数器。

excel vba for-loop range
1个回答
1
投票

尝试不使用 select。

这是我的解释:

Sub Addrow()
    Dim ws As Worksheet
    Dim rngCel2 As Range
    Dim ChkBx As CheckBox
    Set ws = ActiveSheet
    With ws
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        EventNo = lastrow - 4
        NewEvent = EventNo + 1
        .Cells(lastrow, 1) = NewEvent
    
        If NewEvent Mod 2 = 0 Then
            .Range(.Cells(lastrow, 1), .Cells(lastrow, 26)).Interior.Color = RGB(242, 242, 242)
        End If
        
        a = 6                                    'start column
        b = 26                                   'end column
        Application.ScreenUpdating = False
        For x = a To b Step 2                    'step 2 skips to the next
            Set rngCel2 = .Cells(lastrow, x)
            With rngCel2
                Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
                With ChkBx
                    .Value = xlOff
                    .LinkedCell = rngCel2.Address
                    With .Border
                    End With
                End With
                .Interior.Color = rgbGrey
            End With
        Next x
    
    
        For Each ChkBx In .CheckBoxes
            ChkBx.Caption = ""
        Next ChkBx
    End With
 
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.