Clever-Excel-Forum

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

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.

Ja... wie mach ich das?

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

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 Sad

Das wäre der Fall, wenn alle Daten in der Zukunft liegen. Wenn immer ein Tag abgezogen wird, kommt man ja nicht dahin Sad

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

Matix

schauan

Matix

Gast 123

schauan