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的公式应以通常在Excel中复制公式的方式复制到G50中（因此，如果G117中有非$引用指向A117，则它应指向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

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

由于是工作表代码，因此安装非常容易，并且自动使用：

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

如果有任何疑问，请先在试用工作表上尝试。

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

要删除宏：

如上所述调出VBE窗口
清除代码
关闭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项目。然后只有知道密码（me）的人才能破坏我的文件：）

如果用户删除了内容，请用VBA填充单元格

3 个答案: