首页 > 解决方案 > 如何将代码应用于以下所有行

问题描述

我有这个代码,但它只适用于我的第一行。假设查看B,C或D上的复选框是否被选中,如果选中,日期+用户名将自动填写F和G。

这是我的桌子的照片:

在此处输入图像描述

这就是我的代码的样子:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B2") Or Range("C2") Or Range("D2") = True Then
Range("G2").Value = Environ("Username")
Range("F2").Value = Date
Else
Range("F2:G2").ClearContents
End If
End Sub

标签: excelvba

解决方案


在常规模块中输入此代码,选中所有复选框并右键单击 >> 分配宏,然后选择ReviewRows.

每当单击复选框时,这将运行检查 - 有点开销,因为将检查所有行,但应该不是什么大问题。

Sub ReviewRows()
    Dim n As Long
    For n = 1 To 100 'for example
        With Sheet1.Rows(n)
            If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
                If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
                    .Cells(6) = Date
                    .Cells(7) = Environ("Username")
                End If
            Else
                .Cells(6).Resize(1, 2).ClearContents
            End If
        End With
    Next n
End Sub

如果您想更精确,那么Application.Caller将为您提供被单击的复选框的名称,您可以使用它来查找适当的行以通过linkedCell.

Sub ReviewRows()
    Dim n As Long, shp As CheckBox, c As Range, ws As Worksheet
    
    Set ws = ActiveSheet
    On Error Resume Next 'ignore error in case calling object is not a checkbox
    Set shp = ActiveSheet.CheckBoxes(Application.Caller) 'get the clicked checkbox
    On Error GoTo 0 'stop ignoring errors
    
    If Not shp Is Nothing Then          'got a checkbox ?
        If shp.LinkedCell <> "" Then    'does it have a linked cell ?
            With ws.Range(shp.LinkedCell).EntireRow
                If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
                    If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
                        .Cells(6) = Date
                        .Cells(7) = Environ("Username")
                    End If
                Else
                    .Cells(6).Resize(1, 2).ClearContents
                End If
            End With
        End If 'has linked cell
    End If 'was a checkbox
End Sub

但是,此方法对复选框的确切位置很敏感


推荐阅读