Excel 避免硬编码的循环优化

我有五张桌子。 在每个表上，如果我选中一个复选框，他们将自动选中以下所有复选框。如果我取消选中上述复选框，它将取消选中以下所有复选框。我写了一些适用于一个表的代码，但我不想为每个不同的表/范围复制这些代码。有没有办法优化这段代码，这样我就不必为所有实例硬编码了

Sub SelectAll_Click()
    Dim rng As Range, cell As Range
    
    If Range("A17") = TRUE Then
        For Each cell In Range("B19:B28")
            cell.Value = TRUE
            Cells(cell.Row, "F").Value = Now
            Cells(cell.Row, "G").Value = VBA.Environ("Username")
        Next cell
    Else
        For Each cell In Range("B19:B28")
            cell.Value = FALSE
            Cells(cell.Row, "F").ClearContents
            Cells(cell.Row, "G").ClearContents
        Next cell
    End If
End Sub

例如： 红色：“coches si non requires”是法语中“如果不需要检查”的意思

编辑：

我尝试了@chris neilsen所回答的内容——它是有效的，但是响应时间太慢了。我觉得它没有优化。。。这是最终代码：

Sub SelectAll(rCheck As Range, rUpdate As Range, colTime As Long, colUser As Long)
    Dim cell        As Range
    
    If rCheck = TRUE Then
        Sheets("Sheet2").Unprotect Password:="abc"
        For Each cell In rUpdate
            cell.Value = TRUE
            cell.EntireRow.Cells(1, colTime).Value = Now
            cell.EntireRow.Cells(1, colUser).Value = VBA.Environ("Username")
        Next cell
    Else
        For Each cell In rUpdate
            Sheets("Sheet2").Unprotect Password:="abc"
            cell.Value = FALSE
            cell.EntireRow.Cells(1, colTime).ClearContents
            cell.EntireRow.Cells(1, colUser).ClearContents
        Next cell
    End If
    Sheets("Sheet2").Protect Password:="abc"
End Sub

Sub SelectAll_Click()
    SelectAll Range("A17"), Range("B19:B28"), 6, 7
    SelectAll Range("A31"), Range("B33:B35"), 6, 7
    SelectAll Range("A38"), Range("B40:B41"), 6, 7
    SelectAll Range("A45"), Range("B46:B49"), 6, 7
    SelectAll Range("A52"), Range("B54:B62"), 6, 7
    SelectAll Range("A66"), Range("B67:B72"), 6, 7
    SelectAll Range("A75"), Range("B77:B83"), 6, 7
    SelectAll Range("A86"), Range("B88:B89"), 6, 7
End Sub

---

通过添加一些参数来概括Sub

Sub-SelectAll（rCheck As Range，rUpdate As Range，colTime As Long，colUser As Long）
暗淡单元格作为范围
如果rCheck=TRUE，则
对于rUpdate中的每个单元格
cell.Value=TRUE
cell.EntireRow.Cells（1，colTime）.Value=Now
cell.EntireRow.Cells（1，colUser.Value=VBA.Environ（“用户名”）
下一个细胞
其他的
对于rUpdate中的每个单元格
cell.Value=FALSE
cell.EntireRow.Cells（1，colTime）.ClearContents
cell.EntireRow.Cells（1，colUser）.ClearContents
下一个细胞
如果结束
端接头

在Click事件中调用它，传递所需的参数

Sub-SelectAll\u单击（）
选择所有范围（“A17”）、范围（“B19:B28”）、6、7
端接头

上面的答案解决了最初提出的问题：有没有一种方法可以优化此代码，这样我就不必为所有实例硬编码

Sub SelectAll_Click()
    Dim rng As Range, cell As Range
    
    If Range("A17") = TRUE Then
        For Each cell In Range("B19:B28")
            cell.Value = TRUE
            Cells(cell.Row, "F").Value = Now
            Cells(cell.Row, "G").Value = VBA.Environ("Username")
        Next cell
    Else
        For Each cell In Range("B19:B28")
            cell.Value = FALSE
            Cells(cell.Row, "F").ClearContents
            Cells(cell.Row, "G").ClearContents
        Next cell
    End If
End Sub

还谈到优化速度，考虑这个

子选择全部（单击）（）
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
工作表（“Sheet2”）。取消保护密码：=“abc”
选择所有范围（“A17”）、范围（“B19:B28”）、6、7
选择所有范围（“A31”）、范围（“B33:B35”）、6、7
选择所有范围（“A38”）、范围（“B40:B41”）、6、7
选择所有范围（“A45”）、范围（“B46:B49”）、6、7
选择所有范围（“A52”）、范围（“B54:B62”）、6、7
选择所有范围（“A66”）、范围（“B67:B72”）、6、7
选择所有范围（“A75”）、范围（“B77:B83”）、6、7
选择所有范围（“A86”）、范围（“B88:B89”）、6、7
Application.ScreenUpdating=TRUE
Application.Calculation=xlCalculationAutomatic
工作表（“工作表2”）。保护密码：=“abc”
端接头
子选择全部（rCheck As Range、rUpdate As Range、colTime As Long、colUser As Long）
如果rCheck=TRUE，则
rUpdate.Value=TRUE
rUpdate.EntireRow.Columns（colTime）.Value=Now
rUpdate.EntireRow.Columns（colUser.Value=VBA.Environ（“用户名”）
其他的
rUpdate.Value=FALSE
rUpdate.EntireRow.Columns（colTime）.ClearContents
rUpdate.EntireRow.Columns（colUser.ClearContents）
如果结束
端接头

是一个支票簿用于检查所有五个表，还是每个表都有自己的复选框？@Jimber每个表都有自己的复选框！请看编辑后的问题非常感谢您的回答，请看编辑后的问题！非常感谢你-太好了！！