Clever-Excel-Forum

Normale Version: Excel2010 - VBA Code erweitern - wenn "verfügbar" Zelle leeren
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2
Ich möchte in Spalte A über ein Dropdown Menü zwischen "Verfügbar" und "Entliehen" auswählen.
Wenn ich "Entliehen" wähle, soll er in die Spalte B in die jeweilige Zelle das aktuelle Datum packen. Hierbei muss beachtet werden, dass das Datum ein statisches ist. Beim nächsten öffnen der Tabelle darf also nicht das Datum auf das heutige aktualisiert werden.

Dieses habe ich mit folgendem Code auch schon gelöst.
Option Explicit

'***********************************************************************
' Reagiert nur auf die Eingaben in den Zellen "A1:A9999"
'***********************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range ' Reaktionbereich

' Bei Mehrfachauswahl von Zellen Programm beenden
If Target.Cells.Count > 1 Then Exit Sub

' Arbeitsbereich referenzieren
Set Bereich = Range("A1:A9999")

' Nur im Bereich B23 reagieren
If Intersect(Target, Bereich) Is Nothing Then Exit Sub

' Nur wenn der Wert = "Done", dann aktuelles Datum schreiben
If Target.Value <> "Entliehen" Then Exit Sub
' Datum in Spalte B schreiben
Cells(Target.Row, Target.Column + 1).Value = Date


' Objektvariable löschen
Set Bereich = Nothing
End Sub


Problem ist nun :
Wenn ich "Verfügbar" auswähle, müsste Zelle B gecleart werden, heißt dass er bei den Zellen wo ich dann Verfügbar auswähle, soll die Zelle leer werden oder "leer" stehen.

Wie kann ich dies in den obenstehenden Code einbetten ?

Hoffe mir kann jemand weiterhelfen.
Hallo,

versuche es einmal so:

Code:
Option Explicit

'***********************************************************************
' Reagiert nur auf die Eingaben in den Zellen "A1:A9999"
'***********************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range ' Reaktionbereich

' Bei Mehrfachauswahl von Zellen Programm beenden
If Target.Cells.Count > 1 Then Exit Sub

' Arbeitsbereich referenzieren
Set Bereich = Range("A1:A9999")

' Nur im Bereich reagieren
If Intersect(Target, Bereich) Is Nothing Then Exit Sub

' Nur wenn der Wert = "Done", dann aktuelles Datum schreiben
If Target.Value <> "Entliehen" Or Target.Value <> "Verfügbar" Then Exit Sub
If Target.Value = "Entliehen" then

' Datum in Spalte B schreiben
Cells(Target.Row, Target.Column + 1).Value = Date

Else

' Datum in Spalte B löschen
Cells(Target.Row, Target.Column + 1).Value = ""

End If

' Objektvariable löschen
Set Bereich = Nothing
End Sub
Hallo paulfxsmr,

zuerst beginnt man einen Post natürlich mit einer Begrüßung. Eine "Guten Tag" wäre passend, aber auch ein "Hallo" oder "Hi" wäre ok.
Am Ende sollte man den Post mit einer Grußformel beenden. Da wäre als Hilfesuchender ein "Schon mal vielen Dank" aus meiner Sicht sehr passend.
Mehr dazu findest Du hier https://www.clever-excel-forum.de/thread-297.html

Nun aber zu deinem Problem:
Probier doch mal:
Code:
' Nur wenn der Wert = "Done", dann aktuelles Datum schreiben
If Target.Value = "Entliehen" Then
    ' Datum in Spalte B schreiben
    Cells(Target.Row, Target.Column + 1).Value = Date
Elseif Target.Value = "Verfügbar" Then
    ' Datum in Spalte B löschen
    Cells(Target.Row, Target.Column + 1).Value = ""
End if
Der Code ist ungetestet.

Gruß und schönes Wochenedne,
Lutz
Hallo Lutz Fricke,

da gebe ich dir natürlich vollkommen recht. In der Euphorie, dass mir eventuell jemand helfen kann habe ich daran nicht gedacht. Ich bitte dies zu entschuldigen.

Ich habe deinen Code jetzt folgedermaßen eingefügt.
____________________________________________________________________
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range

If Target.Cells.Count > 1 Then Exit Sub

Set Bereich = Range("A1:A9999")

If Intersect(Target, Bereich) Is Nothing Then Exit Sub

If Target.Value <> "Entliehen" Then Exit Sub
Cells(Target.Row, Target.Column + 1).Value = Date
ElseIf Target.Value = "Verfügbar" Then
    Cells(Target.Row, Target.Column + 1).Value = ""

End If
Set Bereich = Nothing
End Sub

___________________________________________________________

Leider ohne Erfolg. Wenn ich in Spalte A in der Zelle des Dropdownmenüs "Entliehen" mache macht er weiterhin wunderbar das Datum von heute rein, welches auch statisch bleibt.
Stelle ich jedoch auf Verüfgbar bleibt in Spalte B weiterhin das Ausleihdatum stehen und die Zelle wird nicht "Geleert"

Eventuell eine Idee woran es liegen könnte ?

Vielen dank :)

Felix
Hallo Felix,

schau mal nach, wie die Zelle mit dem Suchwort formatiert ist: als Text oder Zahl oder Standard. Versuche verschiedene Formatiierungen. Mit Text müsst die Prüfung eigentlich "wahr" sein.

Grüße

Norbert
Also Spalte A, also dort wo das Suchwort "Entliehen" oder "Verfügbar" steht ist in text fomatiert.

Weiß ehrlich gesagt nicht mehr weiter. 


Muss ich den Code als Sub laufen lassen, also über makro gehen ?
Denn aktuell läuft es ja über Option Explicit ?

Bin dahingehend leider nicht so versiert, da Erzieher und ich dass nur selten mache :)

LG
Hola,

https://www.clever-excel-forum.de/misc.php?action=help&hid=10
lesen und umsetzen bitte.

Gruß,
steve1da
Habe das Problem bereits in einem anderen Forum angesprochen,

hier einmal der Link: Excel Problem 

vlt. findet ihr da noch Ansätze.

LG

Hier einmal die Beispielmappe. Vlt hilft das ja jemandem weiter

Vielen dank.
Hallöchen,

in Deinem Code steht

If Target.Value <> "Entliehen" Then Exit Sub

Wenn also was anderes als Entliehen, z.B. Verüfgbar, wird das Makro verlassen und nix gemacht.
Ich beziehe mich auf #4, Deine Datei habe ich mir nicht angeschaut.
Hallo Felix,

ich habe erst heute früh die Nachricht bekommen, dass Du geantwortet hast...

Du hast meinen Code nicht komplett übernommen. Bei
Code:
If Target.Value <> "Entliehen" Then Exit Sub
ist das 
Code:
Exit Sub
zuviel.

Einfach rauslöschen und sollte funktionieren. (Mich wundert eh, dass dein Code läuft...)

Gruß,
Lutz
Seiten: 1 2