AW: Makro überschreibt, solls aber nicht
24.08.2005 09:50:23
Erich
Hallo Dirk,
das Problem tritt nicht nur bei Tagesfahrten auf. Probier mal (mit dem alten Makro nacheinander die Fahrten 26.08. bis 28.08. und 25.08. bis 27.08. aus. Die zweite Fahrt landet auch unter "eigenes Fzg.", obwohl sie sich mit eder ersten Fahrt überschneidet.
Das liegt daran, dass die prüfst, ob ALLE Zellen einer neuen Fahrt schon durch eine alte Fahrt belegt (also grün) sind. Eine Fahrt soll aber wohl nur dann in einer Spalte eingetragen werden, wenn alle Zellen noch frei sind. Das macht:
Sub Eintrag_Aufträge()
Dim d_Anfangsdatumzeile
Dim d_Anf_Spalte_1
Dim d_Anf_Spalte_2
Dim d_Anf_Spalte_3
Dim d_Anfangstermin
Dim d_Enddatumszeile
Dim d_Endtermin
Dim d_End_Spalte_1
Dim d_End_Spalte_2
Dim d_End_Spalte_3
d_Anfangstermin = ThisWorkbook.Sheets("Eingabe").Range("a1")
d_Endtermin = ThisWorkbook.Sheets("Eingabe").Range("b1")
d_Anfangsdatumzeile = Range("B:B").Find(d_Anfangstermin).Row 'sucht richtige zeile
d_Enddatumszeile = Range("b:b").Find(d_Endtermin).Row
d_Anf_Spalte_1 = "e" & d_Anfangsdatumzeile 'schreibt zelle e und entsprechend zeile
d_Anf_Spalte_2 = "g" & d_Anfangsdatumzeile
d_Anf_Spalte_3 = "i" & d_Anfangsdatumzeile
d_End_Spalte_1 = "e" & d_Enddatumszeile
d_End_Spalte_2 = "g" & d_Enddatumszeile
d_End_Spalte_3 = "i" & d_Enddatumszeile
If d_Endtermin = "" Or d_Endtermin < d_Anfangstermin Then
MsgBox "Tagesfahrt"
Range(d_Anf_Spalte_1).Select
If Selection.Interior.ColorIndex = 4 Then
Range(d_Anf_Spalte_2).Select
If Selection.Interior.ColorIndex = 4 Then
Range(d_Anf_Spalte_3).Select
If Selection.Interior.ColorIndex = 4 Then
MsgBox "Mit dieser Software können nur maximal 3 Aufträge verwaltet werden"
Else
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End If
Else
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End If
Else
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End If
Else
'hier muß Prüfung der Zeilen auf grünen Hintergrund passieren
MsgBox "Mehrtagesfahrt"
Range(d_Anf_Spalte_1, d_End_Spalte_1).Select
If Selection.Interior.ColorIndex = xlColorIndexNone Then
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
Range(d_Anf_Spalte_2, d_End_Spalte_2).Select
If Selection.Interior.ColorIndex = xlColorIndexNone Then
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
Range(d_Anf_Spalte_3, d_End_Spalte_3).Select
If Selection.Interior.ColorIndex = xlColorIndexNone Then
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
MsgBox "Mit dieser Software können nur maximal 3 Aufträge verwaltet werden"
End If
End If
End If
End If
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort