Zellen je nach Eingabe sperren

  • Excel

Es gibt 5 Antworten in diesem Thema. Der letzte Beitrag () ist von roddy.

    Zellen je nach Eingabe sperren

    Hallo,

    ich hab ein Berechnungstool, wofür verschiedene Eingabewerte erforderlich sind. Jetzt hab ich zbsp eine Zelle A1 oder eine Zelle B1 in die jeweils Werte eingegeben werden können. Wird zuerst in A1 eingegeben, soll B1 gesperrt und schraffiert sein. Wird zuerst in B1 eingegeben dann A1 gesperrt....

    Danke im voraus

    Das kannst du über das Worksheet_Change-Ereignis der entsprechenden Tabelle steuern. Der Parameter Target enthält die geänderte Zelle als Range-Objekt. Achtung: Werden mehrere Zellen gleichzeitig geändert (zum Beispiel beim Unten-Ausfüllen), ist Target der entsprechende Zellbereich.

    Ich hab' mir das so vorgestellt:

    Visual Basic-Quellcode

    1. Private Sub Worksheet_Change(ByVal Target As Range)
    3. Dim Sperrzelle As Range, sperren As Boolean
    5. If Target.FormulaR1C1 <> "" Then
    7. sperren = True
    9. Select Case Target.Address
    10. Case "$A$1": Set Sperrzelle = Range("B1")
    11. Case "$B$1": Set Sperrzelle = Range("A1")
    12. Case Else: sperren = False
    13. End Select
    15. If sperren Then
    17. 'Hintergrundmuster ändern (hier: Schrägstriche):
    18. With Sperrzelle.Interior
    19. .ColorIndex = 0
    20. .Pattern = xlLightUp
    21. .PatternColorIndex = xlAutomatic
    22. End With
    24. 'Gültigkeitsregel festlegen, sodass keine Werte eingegeben können:
    25. With Sperrzelle.Validation
    26. .Delete
    27. .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=FALSE"
    28. .IgnoreBlank = True
    29. .InCellDropdown = True
    30. .InputTitle = ""
    31. .ErrorTitle = ""
    32. .InputMessage = ""
    33. .ErrorMessage = "Hier dürfen keine Werte eingegeben werden."
    34. .ShowInput = True
    35. .ShowError = True
    36. End With
    38. End If
    40. End If
    42. End Sub


    Diesen Code in die Code-Ebene des betreffenden Tabellenblatts einfügen.

    ok, erstmal danke,

    gibt jedoch ab und an eine "Typenunverträglichkeit Fehler 13" für If Target.FormulaR1C1 <> "" Then

    das Makro läuft auch nicht gleich los, wenn ich eine der beiden zellen gefüllt hab.

    Wie könnte ich die Felder wieder freigeben lassen wenn ich den Wert aus einer der beiden Zellen lösche?

    roddy schrieb:

    Werden mehrere Zellen gleichzeitig geändert (zum Beispiel beim Unten-Ausfüllen), ist Target der entsprechende Zellbereich.


    Dass hatte ich bei meinem Beispiel nicht bedacht, daher die Fehlermeldung. :cursing:

    Jedenfalls müsste hiermit sowohl die Fehlermeldung nicht mehr kommen als auch das Entsperren ermöglicht werden:

    Visual Basic-Quellcode

    1. Private Sub Worksheet_Change(ByVal Target As Range)
    3. Dim Sperrzelle As Range, sperren As Boolean
    5. sperren = True
    7. Select Case Target.Address
    8. Case "$A$1": Set Sperrzelle = Range("B1")
    9. Case "$B$1": Set Sperrzelle = Range("A1")
    10. Case Else: sperren = False
    11. End Select
    13. If sperren Then
    15. If Target.FormulaR1C1 = "" Then
    16. 'Zellinhalt wurde gelöscht.
    18. 'Hintergrundmuster wiederherstellen (hier: kein Hintergrund):
    19. Sperrzelle.Interior.ColorIndex = xlNone
    21. 'Gültigkeitsregel löschen:
    22. Sperrzelle.Validation.Delete
    24. Else
    25. 'Es wurde ein Wert eingegeben.
    27. 'Hintergrundmuster ändern (hier: Schrägstriche):
    28. With Sperrzelle.Interior
    29. .ColorIndex = 0
    30. .Pattern = xlLightUp
    31. .PatternColorIndex = xlAutomatic
    32. End With
    34. 'Gültigkeitsregel festlegen, sodass keine Werte eingegeben können:
    35. With Sperrzelle.Validation
    36. .Delete
    37. .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=FALSE"
    38. .IgnoreBlank = True
    39. .InCellDropdown = True
    40. .InputTitle = ""
    41. .ErrorTitle = ""
    42. .InputMessage = ""
    43. .ErrorMessage = "Hier dürfen keine Werte eingegeben werden."
    44. .ShowInput = True
    45. .ShowError = True
    46. End With
    48. End If
    50. End If
    52. End Sub