2 Probleme lösen (Datum und Change Event)

[Matix]

Hallo zusammen,
zum Wochenende sitz ich wieder vor zwei Fällen wo ich nicht so richtig weiter komme.

1.
In einer Spalte suche ich nach dem aktuellen Datum
und setze es unter die Fixierung. Das funktioniert ganz gut.
Nun kann es passieren dass das Datum nicht in der Spalte ist, weil
es dazu keine Daten gibt. Genau da ist mein Problem: Es soll das Datum
welches vorher zu finden ist, entsprechend unter die Fixierung gesetzt werden.
Also der 01.02.2019 ist zu finden funktioniert am 01.02.2019 wehrend
es am 02.02.2019 nicht funktioniert, da dieser Tag nicht vorkommt, in dem Fall
muss der 31.01.2019 unter der Fixierung sein.
hier mal mein Code dazu:

Code:

Sub Datumfix

Dim rngCell As Range
Dim Ziel As Range, Zeile As Long, Spalte As Long

   Set Ziel = .Range("A11:A150000").Find(Date)
   Zeile = Ziel.Row
   Spalte = 1
       With ActiveWindow
          .ScrollColumn = Spalte
          .ScrollRow = Zeile

end sub

Das 2. Problem was ich habe ist,
Das ich die Spalte A permanent Prüfe ob es eine Veränderung gibt. So lang man etwas füllt lösst es ein ereignis aus,
funktioniert auch. Löscht man allerdings etwas endet das mit einer Endlosschleife. Kann ich das unterbinden?

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim rngCell As Range

If Worksheets("A-Daten").Range("C3") <> "" Then

Application.EnableEvents = False

Select Case Target.Column

   Case 1
       If Target Is Nothing Then Exit Sub
       For Each rngCell In Target.Cells
           If Trim$(rngCell.Value) <> "" Then

               'Wochentag in Spalte B
               rngCell.Offset(, 1) = Format(rngCell.Offset(, 0), "DDDD")

               'Timestamp in B8
               Sheets("Auslastung").Range("B8") = Format(Now(), "DD.MM.YY") & " / " & Format(Now(), "hh:mm")

               'Tag in Hilfstabelle übernehmen
               Sheets("A-Daten").Range("O22") = rngCell.Offset(, 0)


               'S1 weiß
               If rngCell.Offset(, 2) = "" Then
                   If rngCell.Offset(, 1) = "Freitag" Then
                      rngCell.Offset(, 2) = Sheets("A-Daten").Range("C12").Value
                      rngCell.Offset(, 3) = Sheets("A-Daten").Range("D12").Value
                      Else
                      rngCell.Offset(, 2) = Sheets("A-Daten").Range("C11").Value
                      rngCell.Offset(, 3) = Sheets("A-Daten").Range("D11").Value
                   End If
                   If rngCell.Offset(, 1) = "Samstag" Then
                      rngCell.Offset(, 2) = Sheets("A-Daten").Range("C13").Value
                      rngCell.Offset(, 3) = Sheets("A-Daten").Range("D13").Value
                   End If
                   If rngCell.Offset(, 1) = "Sonntag" Then
                      rngCell.Offset(, 2) = Sheets("A-Daten").Range("C14").Value
                      rngCell.Offset(, 3) = Sheets("A-Daten").Range("D14").Value
                   End If
                   If Sheets("A-Daten").Range("I5") = "x" Then 'Feiertag
                      rngCell.Offset(, 2) = "-"
                      rngCell.Offset(, 3) = "-"
                      rngCell.Offset(, 33) = "Feiertag!"
                   End If

               End If
      Next





   Case Else

End Select

Application.EnableEvents = True

End If


End Sub

[schauan]

Hallöchen,

1) wenn Du ein Datum nicht findest, könntest Du per Schleife immer einen Tag abziehen und suchen, bis was gefunden wird.

2) prüfe, ob im Target was drin steht. Wird gelöscht, steht da ja nichts mehr.

[Matix]

Ja... wie mach ich das?

[Gast 123]

Hallo

das löschen eines Bereiches oder einer Zelle unterbinden ist am einfachsten mit IF  VOR  der Target Ausführung:
Für das Datum Problem habe ich im Augenblick keine Lösung. 

mfg  Gast 123

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rngCell As Range
'Löschen eines Bereiches oder einer Zelle > Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

[schauan]

Hallöchen,

hier mal die Sache mit dem Datum. Wichtig ist die Begrenzung der Schleife, hier z.B. mit Date-3. Ansonsten hast Du, wenn es das jeweils gesuchte Datum nicht gibt, eine Endlosschleife Das wäre der Fall, wenn alle Daten in der Zukunft liegen. Wenn immer ein Tag abgezogen wird, kommt man ja nicht dahin

Option Explicit

Sub DatumFinden()
'Variablendeklarationen 
Dim rngDate, dCnt As Date
'aktuelles Datum übernehmen 
dCnt = Date
'aktuelles Datum finden 
Set rngDate = Range("A1:A3").Find(dCnt)
'Schleife, solange Datum nicht gefunden und groesser heute -3 
Do While rngDate Is Nothing And dCnt > Date - 3
  'Datum um 1 Tag reduzieren 
  dCnt = dCnt - 1
  'Datum finden 
  Set rngDate = Range("A1:A3").Find(dCnt)
'Ende Schleife, solange Datum nicht gefunden und groesser heute -3 
Loop
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0