Office: (Office 2019) Datum nach Eingabe automatisch in Zelle einfügen

Hallo Spezialisten,
ich habe hier einen Code gefunden, der für mich fast perfekt ist.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Quelle: Ransi
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
        Target.Offset(0, 1).ClearContents
        Else:
        Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
    End If
End Sub

Ich habe versucht, den Code für 2 Spalte zu ändern, also nicht nur ("A1:A10") sondern auch noch ("L1:L10"). Dazu habe ich es so versucht:

Code:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Quelle: Ransi
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
        Target.Offset(0, 1).ClearContents
        Else:
        Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
 If Intersect(Target, Range("L1:L10")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
        Target.Offset(0, 1).ClearContents
        Else:
        Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
    End If
End Sub

Leider funktioniert das so nicht. Kann mir bitte jemand helfen?
Vielen Dank im Voraus
Gruß Karlheinz

 

Moin!
Wenn Du etwas irgendwo außerhalb von A1:A10 änderst dann sorgt das erste Then Exit Sub zum Verlassen der Routine.
Die Bereiche kann man sofort zusammenfassen:
Range("B1:B11,L1:L11")
Ich nehme bei so etwas nie If Intersect(Bereich) Is Nothing Then Exit Sub
sondern If Not Intersect(Bereich) Is Nothing Then
Außerdem nehme ich nicht
If Target.Count > 1 Then Exit Sub
sondern
If Target.CountLarge = 1 Then
Ferner ist folgendes völlig oversized:
= CDate(Format(Now, "dd.mm.yyyy"))
Hier reicht
= Date
Langer Rede kurzer Code:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B1:B11,L1:L11")) Is Nothing Then
    With Target
      If .CountLarge = 1 Then 'Bearbeiten mehrerer Zeilen wird abgefangen
        If .Value = "" Then
          .Offset(0, 1).ClearContents
        Else
          .Offset(0, 1) = Date
        End If
      End If
    End With
  End If
End Sub

Gruß Ralf

 

Hallo Ralf,
vielen Dank für deine Code. Ich habe ich für mich getestet und habe einige Unterschiede festgestellt. Da ich VBA nicht so gut verstehe, kann ich dir bei deinen Erklärungen nicht 100% ig folgen, trotzdem danke dafür. Dann habe ich festgestellt, ich habe mich nicht klar und deutlich ausgedrückt. Ich wollte eigentlich 2 Spalten überwachen und dann in 2 verschiedene Zellen eingetragen haben. zum besseren Verständnis:
a1 > 0; f1 =Datum mit Uhrzeit; l1 > 0; g1= Datum mit Uhrzeit.
Bei deinem Code wird das Datum eingetragen aber leider ohne Uhrzeit. Ich habe versucht, das Format der Zelle zu ändern, dann wird das Datum angezeigt und die Uhrzeit mit 0:00. Ferner fand ich das ganz gut, dass wenn der Eintrag gelöscht wurde auch das Datum gelöscht wurde.
Viele Grüß
Karlheinz

 

Ich habe Deinen Code bearbeitet, nicht aber Deinen bisher ungekannten Wunsch.
Wenn Du nicht anpassen kannst, solltest Du gleich korrekt und vollständig beschreiben.

Nun ja, bei Deinem aber auch …
Incl. Uhrzeit: Now statt Date

Die entscheidende Methode ist Offset
Zelle.Offset(Zeilenversatz, Spaltenversatz)

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1:A11,L1:L11")) Is Nothing Then
    With Target
      If .CountLarge = 1 Then 'Bearbeiten mehrerer Zeilen wird abgefangen
        Select Case .Column 'Spaltenabfrage
          Case 1 'Spalte A
            If .Value = "" Then
              .Offset(0, 5).ClearContents
            Else
              .Offset(0, 5) = Now
            End If
          Case 12 'Spalte L
            If .Value = "" Then
              .Offset(0, -5).ClearContents
            Else
              .Offset(0, -5) = Now
            End If
        End Select
      End If
    End With
  End If
End Sub

 

Hallo Ralf,
vielen Dank, dass du so geduldig mit mir bist. Meine Ideen sind nicht leicht zu verstehen oder zu erklären. Leider kommen einige Dinge erst dann ans Licht, wenn es zu spät ist, sorry. Der "neue" Code ist genau das, was ich gesucht und gebraucht habe. Vielen vielen Dank, du bist KLASSE.
Viele Grüße
Karlheinz