ActiveX复选框取消勾选后无法恢复单元格旧值，请求技术支持

问题根源 #

原代码存在两个核心问题：

1. 单个变量originalColor、originalValue在遍历多个匹配单元格时会被反复覆盖，最终仅保留最后一个单元格的数据，导致取消勾选时大部分单元格无法恢复正确的原始值和颜色。
2. 恢复填充色时硬编码了固定RGB值，没有使用存储的原始颜色，导致格式恢复错误。

解决方案 #

使用字典存储每个待修改单元格的原始数据（值、字体颜色、填充色），通过单元格地址作为唯一键，避免数据被覆盖，确保取消勾选时能精准恢复每个单元格的状态。

修正后的VBA代码 #

Private Sub CheckBox1_Click()
    Dim ws As Worksheet
    Dim cell As Range
    Dim targetValue As String
    Dim originalData As Object
    Dim key As String
    Dim rngs(3) As Range
    Dim rng As Range
    
    targetValue = "СОК"
    Set ws = ThisWorkbook.Sheets("Текущее состояние")
    Set originalData = CreateObject("Scripting.Dictionary")
    
    If CheckBox1.Value = True Then
        ' 勾选状态：保存原始数据，隐藏单元格并重置数值
        For Each cell In ws.Range("A1:AE61")
            If cell.Value = targetValue Then
                ' 定义需要处理的四个关联单元格
                Set rngs(0) = cell
                Set rngs(1) = cell.Offset(0, -1)
                Set rngs(2) = cell.Offset(0, -2)
                Set rngs(3) = cell.Offset(0, -3)
                
                For Each rng In rngs
                    key = rng.Address
                    ' 存储当前单元格的原始值、字体颜色、填充色
                    originalData(key) = Array(rng.Value, rng.Font.Color, rng.Interior.Color)
                    ' 设置为白色以隐藏内容
                    rng.Font.Color = RGB(255, 255, 255)
                    rng.Interior.Color = RGB(255, 255, 255)
                Next rng
                
                ' 单独重置目标数值单元格为0
                cell.Offset(0, -2).Value = 0
            End If
        Next cell
    Else
        ' 取消勾选状态：从字典恢复原始数据
        For Each cell In ws.Range("A1:AE61")
            If cell.Value = targetValue Then
                Set rngs(0) = cell
                Set rngs(1) = cell.Offset(0, -1)
                Set rngs(2) = cell.Offset(0, -2)
                Set rngs(3) = cell.Offset(0, -3)
                
                For Each rng In rngs
                    key = rng.Address
                    If originalData.Exists(key) Then
                        ' 恢复原始值、字体颜色、填充色
                        rng.Value = originalData(key)(0)
                        rng.Font.Color = originalData(key)(1)
                        rng.Interior.Color = originalData(key)(2)
                    End If
                Next rng
            End If
        Next cell
        ' 清空字典，避免下次操作残留旧数据
        originalData.RemoveAll
    End If
End Sub

关键改动说明 #

• 用Scripting.Dictionary存储每个单元格的完整原始状态，通过单元格地址作为唯一标识，避免数据覆盖。
• 统一处理关联单元格的状态保存与恢复，确保所有相关字段的格式和值都能正确还原。
• 取消勾选后清空字典，防止多次操作导致的旧数据残留问题。

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