Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

2 Probleme lösen (Datum und Change Event)
#1
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
Antwortento top
#2
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.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#3
Ja... wie mach ich das?
Antwortento top
#4
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
Antwortento top
#5
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

   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste