Option Explicit

Public myCancelled As Boolean
Public Const maxTage = 31, maxProds = 500

'find Zeilennr des Produktregisters...
' qqqdemo1
Function findProdNum(ByVal was As String) As Long
Dim Y As Long, c
If was = "" Then findProdNum = 0: Exit Function
Y = 0: c = ""
While Range("sorte1").Offset(Y, 0) <> was And Y < maxProds
  Y = Y + 1
Wend
''MsgBox y
If Y >= maxProds Then Y = 0 Else Y = Y + 1
findProdNum = Y
End Function

Sub test_findProdNum()
MsgBox findProdNum("Verdura")
End Sub

Function findVorProd() As String
Dim x As Long, Y As Long, c
x = ActiveCell.Column: Y = ActiveCell.Row: c = ""
Do
  Y = Y - 1
Loop Until Cells(Y, x) <> "" Or Y < 4
If Y < 4 Then findVorProd = "" Else findVorProd = Cells(Y, x)
End Function

Sub testfindVorProd()
MsgBox findVorProd
End Sub

Function findNextProdRow() As Long
Dim x As Long, Y As Long
x = ActiveCell.Column: Y = ActiveCell.Row + 1
While Cells(Y, x) = "" And Y <= [maxro]
  Y = Y + 1
Wend
findNextProdRow = Y
End Function

Sub test_findNextProdRow()
MsgBox findNextProdRow
End Sub

Function findProdBeginRow() As Long
Dim x As Long, Y As Long
x = ActiveCell.Column: Y = ActiveCell.Row
While Cells(Y, x) = "" And Y > 5
  Y = Y - 1
Wend
findProdBeginRow = Y
End Function

Sub test_findProdBeginRow()
MsgBox findProdBeginRow
End Sub

Function calcQuantperday(Co As Long, PNum) As Double
'Tagesleistung=Ofenkapazität * produktspezifische Intensität
calcQuantperday = Cells(2, Co + 1) * [sorte1].Offset([PNum] - 1, 1)
End Function

Sub test_calcQuantperday()
MsgBox calcQuantperday(4, 5)
End Sub

Function calcDaysforchange(PNum As Long, PreNum As Long) As Double
'Umstelltage aus Tabelle holen, falls wirklich P-Wechsel vorliegt...
If PNum <> PreNum And PreNum > 0 Then
  calcDaysforchange = [change!Nullpunkt].Offset(PreNum, PNum)
Else
  calcDaysforchange = 0
End If
End Function

Sub test_calcDaysforchange()
MsgBox calcDaysforchange(4, 2)
End Sub

'bereich von zellzeiger bis monatsende um dist zellen runterschieben
Sub SchiebRunter(Dist As Long)
Dim Ro As Long, Co As Long, i As Long
Dim c, D, preintens, Kapaz, v

'versuch auf next kampagnen-beginn zu positionieren, wenn noch nicht dort....
Ro = ActiveCell.Row: Co = ActiveCell.Column
If Cells(Ro, Co) = "" Then Ro = main.findNextProdRow
Cells(Ro, Co).Select ' für den fall dass position verändert wurde

If Ro = [maxro] Then Exit Sub
If Dist <= 0 Then Exit Sub
If Ro + Dist > [maxro] Then Exit Sub
Sheets("Plan").Activate

'a) copy.......
Range(Cells(Ro, Co), Cells([maxro] - Dist, Co + 1)).Select
Selection.Copy

'b) zellzeiger woanders positionieren ...
Cells(Ro + Dist, Co).Select

'c) einfügen ''ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlValues 'nur werte, nicht aber formate

'd) Lücke zwischen zellzeiger und ziel leeren...
Range(Cells(Ro, Co), Cells(Ro + Dist - 1, Co + 1)).Select
Selection.ClearContents

'e) für Lücke mengenwerte von vorausgehendem prod (ab 2.tag) übernehmen....
' e.1) wert v ermitteln (nicht einfach letzten wert, könnte ja 1.tag sein!).....
c = main.findVorProd
D = main.findProdNum(c)
preintens = [sorte1].Offset(D - 1, 1)
Kapaz = Cells(2, Co + 1)
v = preintens * Kapaz

' e.2) wert in Lücke kopieren......
For i = 1 To Dist
  Cells(Ro + i - 1, Co + 1) = v
Next i

Cells(Ro + Dist, Co).Select
End Sub

'bereich von zellzeiger bis monatsende um dist (neg.) zellen raufschieben
Sub SchiebRauf(Dist As Long)
Dim Ro As Long, Co As Long, i As Long
Dim c, D, preintens, Kapaz, v

'auf kampagnen-beginn positionieren....
Co = ActiveCell.Column
Ro = main.findProdBeginRow
Cells(Ro, Co).Select

If Dist >= 0 Then Exit Sub
If Ro + Dist < 5 Then Exit Sub
Sheets("Plan").Activate

'a) copy.......
Range(Cells(Ro, Co), Cells([maxro], Co + 1)).Select
Selection.Copy

'b) zellzeiger woanders positionieren ...
Cells(Ro + Dist, Co).Select

'c) einfügen ''ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlValues 'nur werte, nicht aber formate

'd) Lücke zwischen letzter verschobener zeile und monendezeile leeren...
Range(Cells([maxro] + Dist + 1, Co), Cells([maxro], Co + 1)).Select
Selection.ClearContents

'e) für Lücke mengenwerte von vorausgehendem prod (ab 2.tag) übernehmen....
' e.1) wert v ermitteln (nicht einfach letzten wert, könnte ja 1.tag sein!).....
Cells([maxro] + Dist + 1, Co).Select
c = main.findVorProd
D = main.findProdNum(c)
preintens = [sorte1].Offset(D - 1, 1)
Kapaz = Cells(2, Co + 1)
v = preintens * Kapaz

' e.2) wert in Lücke kopieren......
For i = 1 To Dist * -1
  Cells([maxro] + Dist + i, Co + 1) = v
Next i

' f) scrolling ausgleichen und zellzeiger positionieren...
Cells(5, Co).Select: Cells(Ro + Dist, Co).Select
End Sub

Sub test_copy_range()
Sheets("Plan").Activate
[P22:P24].Copy
[q22].Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub


'Tagesmengen eintragen - dabei umstellzeit berücksichtigen
Sub writeQuants(Ro As Long, Co As Long)
Dim D As Long, nextRo As Long
Dim P As String, Pre As String, PNum As Long, PreNum As Long
Dim Days As Long, Daysforchange As Double, Quantperday As Double

'Produktnummern von Produkt und Vorgänger ermitteln...
Cells(Ro, Co).Select
P = Cells(Ro, Co): PNum = findProdNum(P)

Cells(Ro, Co).Select
Pre = findVorProd: PreNum = findProdNum(Pre)

'wieviel tage lang ...
Cells(Ro, Co).Select
nextRo = findNextProdRow '.. also nachfolger suchen um kampagnenende zu kriegen
Days = nextRo - Ro

'wieviel produzieren wir pro normalen tag (also ohne umstellverlust) ...
Quantperday = main.calcQuantperday(Co, PNum)

'wieviel umstelltage...
Daysforchange = main.calcDaysforchange(PNum, PreNum)

For D = 0 To Days - 1
  If Daysforchange > 0 Then
    If Daysforchange >= 1 Then
      Cells(Ro + D, Co + 1) = 0
      Daysforchange = Daysforchange - 1 '  .. 1 tag weniger zu berücks.
    Else
      Cells(Ro + D, Co + 1) = (1 - Daysforchange) * Quantperday
      Daysforchange = 0 ' nichts mehr zu berücks.  - ab nächstem tag volle leistung
    End If
  Else
    Cells(Ro + D, Co + 1) = Quantperday
  End If
Next D
End Sub

Sub test_writeQuants()
Call writeQuants(7, 12)
End Sub