Remplissez une cellule avec VBA si le contenu est supprimé par l'utilisateur

Voici un exemple très simple qui n'implique que des cellules 3 , A1 , A2 et A3 . Vous devez le modifier pour accueillir vos cellules de formule.

Nous créons d'abord une feuille de calcul secrète (appelée secret ) . Nous plaçons les formules de A1 à A3 de la feuille de calcul principale dans la feuille secrète, mais nous les stockons sous forme de chaînes plutôt que de formules :

Ensuite, nous mettons la macro d'événement de feuille de calcul suivante dans la feuille principale:

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

Le sous-contrôleur surveille les modifications apportées aux trois cellules et si l'une d'entre elles est effacée, cette formule sera restaurée à partir de la feuille de calcul secrète.

Comme il s'agit du code de la feuille de calcul, très facile à installer et à utiliser automatiquement:

1. cliquez avec le bouton droit sur le nom de l'onglet en bas de la fenêtre Excel
2. sélectionnez Afficher le code - cela ouvre une fenêtre VBE
3. collez le contenu et fermez la fenêtre VBE

Si vous avez des doutes, essayez-le d'abord sur une feuille de calcul d'essai.

Si vous enregistrez le classeur, la macro sera enregistrée avec lui. Si vous utilisez une version d'Excel postérieure à 2003, vous devez enregistrer le fichier au format .xlsm plutôt que .xlsx

Pour supprimer la macro:

1. afficher les fenêtres VBE comme ci-dessus
2. effacer le code
3. ferme la fenêtre VBE

Pour en savoir plus sur les macros en général, consultez:

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

et

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

Pour en savoir plus sur les macros d'événements (code de la feuille de calcul), voir:

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

Les macros doivent être activé pour que cela fonctionne!

Voici une autre réponse possible. Afin de copier la formule et de conserver «l'adressage relatif» de la formule, vous devez copier en utilisant la notation R1C1. Donc, un sous-marin rapide pour cela pourrait ressembler à

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

La ligne importante ici est la partie emptyCell.FormulaR1C1 = formulaCell.FormulaR1C1 .

Ensuite , dans l'événement Worksheet_Change , cela pourrait ressembler à ceci

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

Si quelqu'un d'autre a le même problème et veut peut-être utiliser ma solution, qui est une combinaison des suggestions de PeterT et Gary's Student (merci beaucoup à tous les deux):

J'ai d'abord créé une nouvelle feuille de travail dans laquelle je copié toutes les formules que je souhaite conserver. Je me suis assuré de les copier exactement dans la même cellule que dans la feuille d'origine.

J'ai ensuite ajouté ce code à la feuille de calcul d'origine:

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

fonctionne bien pour tous les scénarios dans lesquels le contenu d'une cellule est supprimé, à la fois si l'utilisateur supprime le contenu d'une ou de plusieurs cellules!

Ma prochaine étape consiste à rendre la feuille _secret très cachée, à protéger par mot de passe la structure du classeur puis protégez par mot de passe mon projet vba. Ensuite, seules les personnes qui connaissent le mot de passe (moi) peuvent détruire mon fichier :)