Teil 4:
Sub verplanen_S(par1, par2, par3, par4, par5, par6 As String)
With Worksheets("Sheet1")
For y = .Range("BQC1").Column To .Range("DTL1").Column
If Format(.Range("KC2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JR2")
ElseIf Format(.Range("KD2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JT2")
ElseIf Format(.Range("KE2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JU2")
ElseIf Format(.Range("KC2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("KD2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JS2")
End If
Next
For y = .Range("BQC1").Column To .Range("DTL1").Column
If Format(.Range("JW2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JI2")
ElseIf Format(.Range("JX2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JK2")
ElseIf Format(.Range("JY2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JL2")
ElseIf Format(.Range("JZ2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JN2")
ElseIf Format(.Range("KA2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JO2")
ElseIf Format(.Range("KB2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JQ2")
ElseIf Format(.Range("KE2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JU2")
ElseIf Format(.Range("JW2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("JX2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JJ2")
ElseIf Format(.Range("JY2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("JZ2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JM2")
ElseIf Format(.Range("KA2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("KB2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JP2")
End If
Next
For y = .Range("BQC1").Column To .Range("DTL1").Column
If Format(.Range("KJ2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("IZ2")
ElseIf Format(.Range("KN2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("IY2")
ElseIf Format(.Range("KV2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HX2")
ElseIf Format(.Range("KK2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HE2")
ElseIf Format(.Range("KL2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HF2")
ElseIf Format(.Range("KM2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HL2")
ElseIf Format(.Range("KT2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HP2")
ElseIf Format(.Range("KO2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HQ2")
ElseIf Format(.Range("KP2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HW2")
End If
Next
For y = .Range("BQC1").Column To .Range("DTL1").Column
If .Cells(1, y).Value >= .Range(par5).Value _
And .Cells(1, y).Value <= .Range(par6).Value _
And .Cells(par3, y).Value = "" _
Then
.Cells(par1, y).Value = 1
Else
.Cells(par1, y).Value = 0
End If
Next
End With
Call Ende
End Sub
Sub verplanen_O(par1, par2, par3, par4 As String)
With Worksheets("Sheet1")
For y = .Range("BQC1").Column To .Range("DTL1").Column
If Format(.Range("KC2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JR2")
ElseIf Format(.Range("KD2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JT2")
ElseIf Format(.Range("KE2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JU2")
ElseIf Format(.Range("KC2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("KD2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par4, y).Value = .Range("JS2")
End If
Next
For y = .Range("BQC1").Column To .Range("DTL1").Column
If Format(.Range("JW2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JI2")
ElseIf Format(.Range("JX2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JK2")
ElseIf Format(.Range("JY2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JL2")
ElseIf Format(.Range("JZ2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JN2")
ElseIf Format(.Range("KA2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JO2")
ElseIf Format(.Range("KB2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JQ2")
ElseIf Format(.Range("KE2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JU2")
ElseIf Format(.Range("JW2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("JX2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JJ2")
ElseIf Format(.Range("JY2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("JZ2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JM2")
ElseIf Format(.Range("KA2"), "hh:mm") < Format(.Cells(1, y), "hh:mm") _
And Format(.Range("KB2"), "hh:mm") > Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par3, y).Value = .Range("JP2")
End If
Next
For y = .Range("BQC1").Column To .Range("DTL1").Column
If Format(.Range("KJ2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("IZ2")
ElseIf Format(.Range("KN2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("IY2")
ElseIf Format(.Range("KV2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HX2")
ElseIf Format(.Range("KK2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HE2")
ElseIf Format(.Range("KL2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HF2")
ElseIf Format(.Range("KM2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HL2")
ElseIf Format(.Range("KT2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HP2")
ElseIf Format(.Range("KO2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HQ2")
ElseIf Format(.Range("KP2"), "hh:mm") = Format(.Cells(1, y), "hh:mm") _
Then
.Cells(par2, y) = .Range("HW2")
End If
Next
For y = .Range("BQC1").Column To .Range("DTL1").Column
If .Cells(par3, y).Value = "" _
Then
.Cells(par1, y).Value = 1
Else
.Cells(par1, y).Value = 0
End If
Next
End With
Call Ende
End Sub
Sub Auftrag_Ende()
With Sheets("Sheet1")
.Range("HB3:KW1500").Copy .Range("HB2")
.Range("KW1").Value = .Range("A13").Value - 1
.Range("A13").Value = .Range("KW1").Value
End With
Call Wiederholung
End Sub
Sub Wiederholung()
With Worksheets("Sheet1")
If .Range("KW1") > 0 _
Then
Call Berechnung_Prüfung
ElseIf .Range("KW1") = 0 _
Then
Call Endberechnung
End If
End With
End Sub
|