Liebe Forenmitglieder!
In u.a. Teilcode, versuche ich VOR einem Eintrag von Serienterminen in den Tabellenblättern, die im Array tmparrTab hinterlegt sind, mittels Dictionary zu überprüfen, ob bereits Einträge (mit verbundenen Zellen) vorhanden sind, um Terminkollissionen ggf. zu identifizieren. Folgendes Fehlverhalten zeigt sich:
1.) setzte ich vor dem Eintrag z.b. in zwei Blätter Einzeltermine, wird der erste erkannt, der zweite jedoch nicht, obwohl die Anzahl der für die Serientermine notwendigen Tabellenblätter ausreichen müsste, auch den zweiten Eintrag zu erfassen. Ansonsten läuft der Code wie gewünscht durch, d.h. die Serienterminbuchung wird nicht durchgeführt.
2.) Trage ich eine Terminserie in (sicher)freie Blätter ein, so läuft der Code zunächst normal durch (über MsgBox "Weiter geht's!"), trägt den ersten der Terminserie ein und findet plötzlich diesen als Kollission.
Zum Grundverständnis: Die Anzahl der Serientermine wird über eine Userform ausgewählt und liegt schon im Array tmparrTab fest. Debug.Print (6b) gibt diese auch korrekt aus.
Cells(lngzeA, lngsp) und Cells(lngzeE, lngsp) begrenzen den Zellbereich eines Termins.
Ich frage mich nun, ob ich irrtümlicherweise in einem falschen Array nach Kollisionen suche oder was an dem Code nicht stimmt. Ich hoffe, hier kann mir jemand auf die Sprünge helfen.
Viele Grüße
Volker
'Hier erfolgt Prüfung, ob im gewählten Zeitfenster schon eine Raumbelegung vorliegt
Set oAddr = CreateObject("scripting.dictionary")
For b = 1 To Worksheets(tmparrTab).Count
For Each Zelle In Range(Worksheets(b).Cells(lngzeA, lngsp), _
Worksheets(b).Cells(lngzeE, lngsp))
If Zelle.MergeCells = True Then
Zelle.Worksheet.Tab.ColorIndex = 3
oAddr(Left(Sheets(b).Name, 5) & ": " & _
Zelle.MergeArea.Address(0, 0)) = 0
End If
Next Zelle
Next b
If oAddr.Count Then
sErgebnis = Join(oAddr.keys, vbLf)
Debug.Print "6 " & vbCr & sErgebnis
Debug.Print vbCr & "(6b) " & vbCr & Join(tmparrTab(), vbCr)
'Sind an gewählten Terminen Einträge vorhanden, erfolgt diese Meldung:
MsgBox "Meldung 17" & vbCr & "Achtung !!!" & vbCr & "Es existieren _
bereits Buchungen in:" & vbCr & vbCr & sErgebnis
'Hier erfolgt Meldung, dass die Buchung nicht durchgeführt und abgebrochen wurde
MsgBox "Meldung 18" & vbCr & "Aktuelle Buchung wird abgebrochen!"
'Nachfolgend wird Buchungseintrag wieder entfernt und die Formatierung rückgängig gemacht
ActiveCell.MergeArea.Borders.LineStyle = xlLineStyleNone
ActiveCell.MergeArea.Interior.ColorIndex = 15
ActiveCell.MergeCells = False
ActiveCell.ClearContents
Exit Sub
Else
MsgBox "Weiter geht's!"
End If