Code:
Function VorBe(Hersteller As String, Lieferwoche As String, Bestellt As String) As String
Dim Re As String
Dim Spalte As Long
Dim Reihe As Integer
Dim Jahr As String
Dim Avis As String
Dim StartpunktR As Integer
Dim StartpunktS As Integer
Dim Zelle As String
Dim BestellDate As Date
StartpunktR = 4
StartpunktS = 13
If Bestellt = "" Then
Reihe = WorksheetFunction.WeekNum(Now, 21)
Jahr = Year(Now)
Else
BestellDate = Bestellt
Reihe = WorksheetFunction.WeekNum(BestellDate, 21)
Jahr = Year(Bestellt)
End If
Reihe = Reihe + StartpunktR
If Hersteller = "Nolte" Then
Spalte = 1 + StartpunktS
ElseIf Hersteller = "Nobilia" Then
Spalte = 2 + StartpunktS
ElseIf Hersteller = "Artego" Then
Spalte = 3 + StartpunktS
ElseIf Hersteller = "Impuls" Then
Spalte = 4 + StartpunktS
ElseIf Hersteller = "Eco" Then
Spalte = 5 + StartpunktS
ElseIf Hersteller = "Express" Then
Spalte = 6 + StartpunktS
ElseIf Hersteller = "Häcker" Then
Spalte = 7 + StartpunktS
ElseIf Hersteller = "Decker" Then
Spalte = 8 + StartpunktS
End If
Zelle = CTL(Spalte) & Reihe
Avis = Worksheets(Jahr).Range(Zelle)
Re = KWDiff(Avis, Lieferwoche)
VorBe = Re
End Function
Function CTL(iCol As Long) As String
Dim a As Long
Dim b As Long
a = iCol
CTL = ""
Do While iCol > 0
a = Int((iCol - 1) / 26)
b = (iCol - 1) Mod 26
CTL = Chr(b + 65) & CTL
iCol = a
Loop
End Function
Function KWDiff(Avis As String, Lieferwoche As String) As String
Dim Re As String
Dim Ende As Date
Dim Maxwert As Integer
Dim AnzJ As Integer
Dim TotalL As String
Dim PosA As String
Dim PosL As String
Dim Zeichen As String
If Right(Avis, 2) >= Right(Lieferwoche, 2) Then
AnzJ = Right(Avis, 2) - Right(Lieferwoche, 2)
PosA = InStr(1, Avis, "/", vbTextCompare) - 1
PosL = InStr(1, Lieferwoche, "/", vbTextCompare) - 1
TotalL = Left(Avis, PosA)
Do While AnzJ > 0
Ende = DateValue("Dezember 31," & (Year(Now) + AnzJ - 1))
Maxwert = WorksheetFunction.WeekNum(Ende, 21)
TotalL = TotalL + Maxwert
AnzJ = AnzJ - 1
Loop
Re = TotalL - Left(Lieferwoche, PosL)
Else
AnzJ = Right(Lieferwoche, PosL) - Right(Avis, PosA)
PosL = InStr(1, Lieferwoche, "/", vbTextCompare) - 1
PosA = InStr(1, Avis, "/", vbTextCompare) - 1
TotalL = Left(Lieferwoche, PosL)
Do While AnzJ > 0
Ende = DateValue("Dezember 31," & (Year(Now) + AnzJ - 1))
Maxwert = WorksheetFunction.WeekNum(Ende, 21)
TotalL = TotalL + Maxwert
AnzJ = AnzJ - 1
Loop
Re = Left(Avis, PosA) - TotalL
End If
KWDiff = Re
End Function
Function AusL(Lieferwoche As String, Liefertermin As String) As String
Dim LieferKW As String
Dim LieferJahr As String
Dim TagKW As String
Dim TagJahr As String
Dim Jahr As String
Dim Woche As String
Dim Pos As String
Dim Merker As String
Dim LieferDate As Date
Dim Heute As String
Heute = Date
Merker = 0
Woche = WorksheetFunction.WeekNum(Now, 21)
Jahr = Year(Now)
Jahr = Right(Jahr, 2)
Pos = InStr(1, Lieferwoche, "/", vbTextCompare) - 1
LieferKW = Left(Lieferwoche, Pos)
LieferJahr = Right(Lieferwoche, 2)
If Liefertermin <> "" Then
LieferDate = Liefertermin
If LieferDate < Heute Then
AusL = "Ja"
Merker = 1
Else
AusL = "Nein"
Merker = 1
End If
End If
If LieferJahr <= Jahr And LieferKW < Woche Then
If Merker = 0 Then AusL = "Ja"
Else
If Merker = 0 Then AusL = "Nein"
End If
Lieferwoche = 1
End Function