如何编写VBA实现指定行单元格锁定与K14:K16数据自动计算？

需求说明 #

• 对C14:F16区域逐行处理：若该行内存在勾选的复选框或值>0的单元格，锁定该行其余单元格
• K14:K16（总计列）按规则计算：
  • 对应行C列复选框勾选时，K列值为0
  • 若B2>0，取对应行D列值/30
  • 若C2>0，取对应行E列值/7
  • 若D2>0，取对应行F列值

原代码存在的问题 #

1. 错误引用Range变量（如Range("rng0")是语法错误，直接用变量名即可）
2. 循环逻辑错误：遍历C14:F16的每个单元格，但需求是按行处理，无需逐个单元格遍历
3. 完全缺失单元格锁定的逻辑
4. 复选框引用方式错误，条件判断顺序不符合需求优先级
5. 列偏移计算错误（原代码中Offset(0,10)等对应列不对）

修正后的代码 #

Sub Frequency()
    Dim ws As Worksheet
    Dim targetRow As Range
    Dim cell As Range
    Dim rowNum As Integer
    Dim hasActiveCell As Boolean
    
    Set ws = ActiveSheet ' 指定操作的工作表，可根据实际修改为Sheets("Sheet1")
    
    ' 先解除工作表保护，否则无法修改单元格锁定状态
    If ws.ProtectContents Then
        ws.Unprotect Password:="" ' 若有保护密码，填写到引号内
    End If
    
    ' 逐行处理C14:F16区域
    For rowNum = 14 To 16
        Set targetRow = ws.Range("C" & rowNum & ":F" & rowNum)
        hasActiveCell = False
        
        ' 判断当前行是否有勾选的复选框或值>0的单元格
        For Each cell In targetRow
            ' 检查单元格是否是复选框控件，且已勾选
            If cell.Shapes.Count > 0 Then
                If TypeName(cell.Shapes(1).OLEFormat.Object) = "CheckBox" Then
                    If cell.Shapes(1).OLEFormat.Object.Value = xlOn Then
                        hasActiveCell = True
                        Exit For
                    End If
                End If
            End If
            ' 检查单元格值是否>0
            If cell.Value > 0 Then
                hasActiveCell = True
                Exit For
            End If
        Next cell
        
        ' 根据判断结果锁定或解锁当前行的单元格
        For Each cell In targetRow
            ' 检查当前单元格是否是激活状态（勾选或值>0）
            Dim isActive As Boolean
            isActive = False
            
            If cell.Shapes.Count > 0 Then
                If TypeName(cell.Shapes(1).OLEFormat.Object) = "CheckBox" Then
                    If cell.Shapes(1).OLEFormat.Object.Value = xlOn Then
                        isActive = True
                    End If
                End If
            End If
            If cell.Value > 0 Then
                isActive = True
            End If
            
            ' 锁定非激活单元格，激活单元格保持解锁
            cell.Locked = Not isActive
        Next cell
        
        ' 计算K列（总计）的值
        With ws.Range("K" & rowNum)
            ' 优先判断对应行C列复选框是否勾选
            If ws.Range("C" & rowNum).Shapes.Count > 0 Then
                If TypeName(ws.Range("C" & rowNum).Shapes(1).OLEFormat.Object) = "CheckBox" Then
                    If ws.Range("C" & rowNum).Shapes(1).OLEFormat.Object.Value = xlOn Then
                        .Value = 0
                        GoTo NextRow ' 跳过后续判断
                    End If
                End If
            End If
            
            ' 按B2、C2、D2的条件依次判断
            If ws.Range("B2").Value > 0 Then
                .Value = ws.Range("D" & rowNum).Value / 30
            ElseIf ws.Range("C2").Value > 0 Then
                .Value = ws.Range("E" & rowNum).Value / 7
            ElseIf ws.Range("D2").Value > 0 Then
                .Value = ws.Range("F" & rowNum).Value
            Else
                .Value = "" ' 若所有条件都不满足，清空单元格
            End If
        End With
        
NextRow:
    Next rowNum
    
    ' 重新保护工作表，使锁定生效
    ws.Protect Password:="" ' 若有保护密码，填写到引号内
End Sub

关键逻辑说明 #

1. 工作表保护处理：修改单元格锁定状态前必须解除保护，处理完成后重新保护才能让锁定生效
2. 按行判断激活状态：逐行检查是否存在勾选的复选框或值>0的单元格，标记该行是否需要锁定其余单元格
3. 单元格锁定控制：对每行的每个单元格单独判断，仅锁定非激活状态的单元格
4. 总计列计算优先级：优先判断复选框状态，再按B2、C2、D2的顺序执行计算逻辑
5. 复选框引用：假设C列单元格内嵌了复选框控件，通过Shapes对象获取并判断状态

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