Makro: Datum Zelle mit bestimmten Inhalt gefüllt wird

[pixpaw]

Hi,

ich habe eine Tabelle die ständig erweitert wird.
In einer Spalte wird irgendwann "Installed" eingetragen. Wenn das geschieht, soll in einer anderen Spalte in der gleichen Zeile das aktuelle Datum eingetragen werden.
Gleiches Spiel nur mit einer Zelle, die das Datum wo anders eintragen soll, sobald sie nicht mehr leer ist.

Das ganze konnte ich auch schon realisieren:

Code: [Auswählen]

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

    Dim intRow As Integer
    For intRow = 170 To 180
   
    If Cells(intRow, 17).Text = "Installed" Or Cells(intRow, 17).Text = "Cancelled" Then
        Cells(intRow, 46).Value = Format(Date, "YYYY-MM-DD")
    End If
       
    If Cells(intRow, 1).Text <> "" Then
        Cells(intRow, 43).Value = Format(Date, "YYYY-MM-DD")
       
    End If
    Next intRow
   
   Application.EnableEvents = True

End Sub


Wie man sieht, wird das ganze bisher nur auf die Zeilen 170-180 angewandt.
Mein Problem ist, dass diese Prüfung jede Sekunde gemacht wird. Heißt, lösche ich das Datum, erscheint es direkt wieder.

Zum soll das ganze auf mehrere hundert Zeilen gehen. Mache ich das so wie oben, geht in Excel gar nichts mehr.
Zum anderen wird das Datum immer wieder aktualisiert, weshalb das ganze Morgen schon nicht mehr korrekt ist. Zudem würde ich das Datum auch gern manuell überschreiben können.
Bin nicht so fit in Macros etc und das oben ist nur zusammen gewurschtelt

Jemand ne Idee wie das zu realisieren ist?

[Melanie Breden]

Hallo,

anstatt einen Bereich zu durchsuchen kannst du auch sofort nach einer Änderung die jeweilige Zelle prüfen:

Code: [Auswählen]

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim strColCheck  As String
   Dim strColDate   As String
   Dim strText1     As String
   Dim strText2     As String

   ' Änderung von 1 Zelle überwachen
   If Target.Count > 1 Then Exit Sub
   
   ' Spalte die geprüft werden soll
   strColCheck = "Q"
   ' Spalte für Datum
   strColDate = "AT"
   ' zu prüfender Text
   strText1 = "Installed"
   strText2 = "Cancelled"
   
   ' ist geänderte Zelle in angegebener Spalte?
   If Not Application.Intersect(Target, Columns(strColCheck)) Is Nothing Then
      Application.EnableEvents = False
     
      ' Zellwert prüfen
      Select Case Target.Value
         Case strText1, strText2
            With Cells(Target.Row, strColDate)
               .Value = Date
               .NumberFormat = "YYYY-MM-DD"
            End With
         Case Else
            ' altes Datum löschen
            Cells(Target.Row, strColDate).ClearContents
      End Select
     
      Application.EnableEvents = True
      Exit Sub
   End If
   
   ' 2. Bereich prüfen
   strColCheck = "A"
   strColDate = "AQ"
   
   ' ist geänderte Zelle in angegebener Spalte?
   If Not Application.Intersect(Target, Columns(strColCheck)) Is Nothing Then
      Application.EnableEvents = False
      ' Zellwert prüfen
      If Target.Value <> "" Then
         Cells(Target.Row, strColDate).Value = Date
      Else
         ' altes Datum löschen
         Cells(Target.Row, strColDate).ClearContents
      End If
      Application.EnableEvents = True
   End If
End Sub

Kommst du damit weiter?

Gruß
Melanie

[pixpaw]

klappt wunderbar, danke