如果内容被用户删除，则用 VBA 填充单元格

Question

我正在为我的同事设计一份时间报告。有些单元格包含（隐藏的）公式但未受保护，因为我需要用户仍然能够手动覆盖公式。

现在，如果用户输入他/她自己的内容然后再次删除它，单元格是空的，这是我不想要的，因为它只会导致混乱。

我想编写一个 VBA 宏，它可以识别先前声明的范围内的单元格内容是否被删除/为空，如果它们被删除/为空，则应将另一个（受密码保护和隐藏）单元格中的公式复制到空单元格。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Set myRange = Intersect(Range("F9:I108"), Target)    
If Not myRange Is Nothing Then

'I'm guessing something with WorksheetFunction and possibly CountA,
'but I don't know how to make it work

End If
End Sub

如果一个单元格（或多个单元格）的内容被删除，应该输入的公式总是在第 117 行（同一个工作表）。例如，如果用户删除了 G50，那么 G117 的公式应该被复制到 G50 中，就像您通常在 Excel 中复制公式一样（所以如果 G117 中有指向 A117 的非 $-reference，那么它应该指向 A50将公式复制到 G50 后）。

如果可能，我希望不使用循环——它们总是需要很长时间才能执行。

提前致谢！

Answer 1

这是一个超级简单的例子，只涉及 3 个细胞，A1，A2 和 A3。您必须修改它以适应您的公式单元格。

我们首先创建一个秘密工作表（称为secret）。我们将主工作表中从 A1 到 A3 的公式放入机密表中，但我们将它们存储为 Strings 而不是 Formulas ：

然后我们将以下工作表事件宏放在主工作表中：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Range("A1:A3")

    If Intersect(Target, rng) Is Nothing Then Exit Sub
    If Target.Count <> 1 Then Exit Sub
    If Target.Value <> "" Then Exit Sub

    Application.EnableEvents = False
        Target.Formula = Sheets("secret").Range(Target.Address).Value
    Application.EnableEvents = True

End Sub

子监视器对三个单元格的更改，如果其中任何一个被清除，该公式将从秘密工作表中恢复。

因为是工作表代码，所以安装非常容易，自动使用：

1. 右键单击 Excel 窗口底部附近的选项卡名称
2. 选择查看代码 - 这将打开一个 VBE 窗口
3. 粘贴内容并关闭 VBE 窗口

如果您有任何疑虑，请先在试用工作表上进行尝试。

如果您保存工作簿，宏将与它一起保存。 如果您使用的是 2003 年以后的 Excel 版本，则必须保存 文件为 .xlsm 而不是 .xlsx

要删除宏：

1. 如上所示打开 VBE 窗口
2. 清除代码
3. 关闭 VBE 窗口

要了解有关宏的更多信息，请参阅：

http://www.mvps.org/dmcritchie/excel/getstarted.htm

和

http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

要了解有关事件宏（工作表代码）的更多信息，请参阅：

http://www.mvps.org/dmcritchie/excel/event.htm

必须启用宏才能正常工作！

Answer 2

这是另一个可能的答案。为了复制公式并让它保持公式的“相对寻址”，您需要使用 R1C1 表示法进行复制。所以一个快速的子可能看起来像

Option Explicit

Sub RestoreFormula(ByRef emptyCell As Range)
    Dim formulaWS As Worksheet
    Dim formulaCell As Range
    Set formulaWS = ThisWorkbook.Sheets("Sheet1")
    Set formulaCell = formulaWS.Range("A17")
    emptyCell.FormulaR1C1 = formulaCell.FormulaR1C1
End Sub

这里重要的一行是emptyCell.FormulaR1C1 = formulaCell.FormulaR1C1 部分。

然后，在Worksheet_Change 事件中，它可能看起来像这样

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim checkRange As Range
    Set checkRange = ActiveSheet.Range("A1:A9")
    If Not Intersect(checkRange, Target) Is Nothing Then
        Dim changedCell As Range
        For Each changedCell In Target
            If IsEmpty(changedCell) Then
                RestoreFormula changedCell
            End If
        Next changedCell
    End If
End Sub

Answer 3

如果其他人遇到过同样的问题并且可能想使用我的解决方案，该解决方案结合了 PeterT 和 Gary 学生的建议（非常感谢你们）：

首先，我创建了一个新工作表，在其中复制了我希望保留的所有公式。我确保将它们复制到与原始工作表完全相同的单元格中。

然后我将此代码附加到原始工作表中：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Bereich1 As Range
Set Bereich1 = Range("F9:I108") 'Do NOT enter multiple, non-contiguous ranges here! It crashes Excel!
If Not Intersect(Bereich1, Target) Is Nothing Then
        Dim changedCell1 As Range
        For Each changedCell1 In Target
            If changedCell1 = "" Then
                changedCell1.Formula = Sheets("Tagebuch_secret").Range(changedCell1.Address).Formula
            End If
        Next changedCell1
End If

Dim Bereich2 As Range
Set Bereich2 = Range("E112") 'instead duplicate the code snippet
If Not Intersect(Bereich2, Target) Is Nothing Then
        Dim changedCell2 As Range
        For Each changedCell2 In Target
            If changedCell2 = "" Then
                changedCell2.Formula = Sheets("Tagebuch_secret").Range(changedCell2.Address).Formula
            End If
        Next changedCell2
End If

End Sub

这适用于每个单元格内容被删除的场景，无论是用户删除单个还是多个单元格的内容！

我的下一步是使 _secret 工作表非常隐藏，用密码保护工作簿结构，然后用密码保护我的 vba 项目。那么只有知道密码的人（我）才能销毁我的文件:)