PDA

Vollständige Version anzeigen : Zellwert fixieren


Andy1972
03.07.2015, 20:51
Hallo
ich möchte gern einen Wert (Uhrzeit) automatisch fixieren.
Die Uhrzeit wird über VBA Code eingetragen.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range
' abbrechen, wenn erste Zeile oder mehr als eine Zelle aktiv
If Target.Row < 2 Or Target.Count > 1 Then Exit Sub

'für Änderungen in E2 bis E50. Ggf anpassen
Set RaBereich = Range("B10:B10000")
Application.EnableEvents = False

'bei Änderung eine Zelle links davon Datum und Uhrzeit eintragen
If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, -1) = Format(Now, "hh:mm:ss")
End If

Application.EnableEvents = True
Set RaBereich = Nothing

End Sub


Schon mal danke für eure Hilfe

GMG-CC
03.07.2015, 21:34
ich möchte gern einen Wert (Uhrzeit) automatisch fixieren.
Die Uhrzeit wird über VBA Code eingetragen.

Ja, und der Code tut das doch wohl auch. Was ist also deine Frage?

Andy1972
04.07.2015, 11:23
Hallo,
und danke für die Antwort.
Der Code setzt die aktuelle Uhrzeit, das ist richtig.
Nur wenn ich die Zeile nochmal beschreibe wird die aktuelle Zeit gesetzt. Und dies soll verhindert werden.


MFG
Andy

RPP63neu
04.07.2015, 11:29
Hi!
Ergänze folgendes:
If Target.Row < 2 Or Target.Count > 1 Then Exit Sub
If IsDate(Target.Offset(0, -1)) Then Exit Sub
Gruß Ralf

Andy1972
04.07.2015, 11:54
Hallo
Danke für den Code.

Brauch ich den nur einfügen oder gehört der wo bestimmtes hin? :eek:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range
' abbrechen, wenn erste Zeile oder mehr als eine Zelle aktiv
If Target.Row < 2 Or Target.Count > 1 Then Exit Sub

'für Änderungen in E2 bis E50. Ggf anpassen
Set RaBereich = Range("B10:B10000")
Application.EnableEvents = False

'bei Änderung eine Zelle links davon Datum und Uhrzeit eintragen
If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, -1) = Format(Now, "hh:mm:ss")
End If

Application.EnableEvents = True
Set RaBereich = Nothing

If Target.Row < 2 Or Target.Count > 1 Then Exit Sub
If IsDate(Target.Offset(0, -1)) Then Exit Sub

End Sub

Wenn ich ihn so reinkopiere wird die Uhrzeit, durch erneutes beschreiben der Zelle mit dem akutellen Uhrzeit beschrieben.

RPP63neu
04.07.2015, 12:18
Hi!
So meinte ich das (wenn ich Dich richtig verstanden habe):
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range
' abbrechen, wenn erste Zeile oder mehr als eine Zelle aktiv
If Target.Row < 2 Or Target.Count > 1 Then Exit Sub
If IsDate(Target.Offset(0, -1)) Then Exit Sub

'für Änderungen in E2 bis E50. Ggf anpassen
Set RaBereich = Range("B10:B10000")
Application.EnableEvents = False

'bei Änderung eine Zelle links davon Datum und Uhrzeit eintragen
If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, -1) = Format(Now, "hh:mm:ss")
End If

Application.EnableEvents = True
Set RaBereich = Nothing
End Sub
Benutze bitte Code-Tags, dann lässt sich der Code leichter lesen.

Andy1972
04.07.2015, 12:33
Hallo,

geht leider nicht.
Lade mal das Arbeitsblatt rauf.

Momentan ist es ja so das wenn ich in "Beschreibung" "B10" einen Text reinschreibe wird bei "Uhrzeit" "A10" die aktuelle Uhrzeit gesetzt.
Das ist auch so richtig.

Schreibe ich aber später noch mal was in "B10" ändert sich die Uhrzeit wieder und genau das soll nicht sein. Es soll quasi nach Eingabe in B10 die Uhrzeit gesperrt, Fixiert, nicht mehr änderbar sein.

MFG
Andy

GMG-CC
04.07.2015, 15:11
Moin,

ich hätte es wie Ralf vorgeschlagen, musste mich aber eines Besseren belehren lassen ... (Uhrzeit ist kein DATE-Wert :mad: ) So geht es aber:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range
' abbrechen, wenn erste Zeile oder mehr als eine Zelle aktiv
If Target.Row < 2 Or Target.Count > 1 Then Exit Sub
If Target.Offset(0, -1) > "" Then Exit Sub

'für Änderungen in E2 bis E50. Ggf anpassen
Set RaBereich = Range("B10:B10000")
Application.EnableEvents = False

'bei Änderung eine Zelle links davon Datum und Uhrzeit eintragen
If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, -1) = Format(Now, "hh:mm:ss")
End If

Application.EnableEvents = True
Set RaBereich = Nothing
End Sub

Übriges sollte dein Code und die Tabelle etwas geändert werden. Der Code wird auch bei einem einzigen Leerzeichen in Spalte_B das (unveränderliche) Datum schreiben. - Und es wäre wesentlich vorteilhafter (und auch mitRalfs Code nutzbar), wenn du in Spalte_A Datum und Uhrzeit schriben und als Uhrzeit formatieren würdest. Bei einem Einsatz über Mitternacht hinaus oder gar mehrere Tage wohl deutlich klarer.

Andy1972
04.07.2015, 15:30
Hallo,

so habe ich mir das Vorgestellt :-)
Danke

Was müsste ich dann noch ändern?
Spalte bzw. Zellen ist mit Uhrzeit formatiert

GMG-CC
04.07.2015, 15:43
Richtig Andy,

Spalte_A ist als Uhrzeit formatiert. Aber eben nur mit einer Uhrzeit als Wert. Ein Einsatz beginnt am 31.12.2014 22:00 und endet am 2.1.2015 19:00. Dann hast du beispielsweise diese Werte in Spalte_A stehen:
22:00
03:00
18:40
07:25
18:59
Schön, und wie willst du die auswerten? Sicher sind doch nur der erste und der letzte Wert, den Rest kann man sich denken ...

Also: If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, -1) = Now
End If
Dann siehst du in Spalte_A nur die Uhrzeit, in der Editierzeile jedoch das komplette Datum, welches auch so ausgewertet werden kann bei einer Berechnung der Gesamt-Einsatzzeit.

Um das alleinige Leerzeichen abzufangen änderst du die Zeile so ab:
If Not Intersect(Target, RaBereich) Is Nothing Then
If Trim(Target) > "" Then Target.Offset(0, -1) = Now
End If


... Es ist warm ...

Andy1972
04.07.2015, 15:49
Funktioniert PERFEKT :-) :-)
Danke