AW: aber...
12.08.2017 16:47:27
fcs
Hallo Bernd,
man muss die Zeile in den Formeln im Bereich F6:J8 hier mit einem absoluten Bezug einbauen, d.h. die Zeile muss erst berechnet werden.
Bei der Summenformel für die KW funktioniert es nur, wenn auch eine Tätigkeit in Spalte B eingetragen wurde, ansonsten gibt es Formel/Werte-Chaos.
Die Summenzeile kann man z.B. ermitteln, indem man in Spalte B nach "Problemspeicher" sucht und dann 2 abzieht.
Alternativ ginge auch eine Suche in Spalte K nach "*Summe aktuelle KW".
Gruß
Franz
Private Sub CommandButton2_Click()
' neue Zeile einfügen für Aufgabe oder Problem
Dim EZ As Double
Dim Ab As Double
Dim WoEinf As String
Dim ZL As Long
Application.ScreenUpdating = False
WoEinf = InputBox("(A)ufgabe" & vbLf & "(P)roblem", _
"Wo möchten Sie eine neue Zeile hinzufügen?", "A")
Select Case UCase(WoEinf)
Case "A"
EZ = UF_neueZeile(12, True) '8
'Zeile mit Summenzeile
ZL = Range("B:B").Find(What:="Problemspeicher", LookIn:=xlValues, _
lookat:=xlPart).Row - 2
'Summenformeln für aktuelle KW
Range("F" & ZL & ":J" & ZL).FormulaR1C1 = _
"=SUMPRODUCT(((R12C4:R[-1]C4=""KW ""&TRUNC((TODAY()-DATE(YEAR(TODAY()+" _
& "3-MOD(TODAY()-2,7)),1,MOD(TODAY()-2, 7)-9) )/7))+(R12C4:R[-1]C4=""""))" _
& "*(R12C:R[-1]C))"
'Zeile oberhalb Summenzeile
ZL = ZL - 1
'Summenformeln für Cluster
Range("F6:J8").FormulaR1C1 = _
"=IFERROR(SUMPRODUCT((R12C3:R" & ZL & "C3=RC3)*(R12C4:R" & ZL _
& "C4=""KW ""&TRUNC((TODAY()-DATE(YEAR(TODAY()+3-MOD(TODAY()-2,7)),1," _
& "MOD(TODAY()-2, 7)-9) )/7))*(R12C:R" & ZL & "C))/SUM(R12C:R" & ZL & "C),0)"
Cells(EZ, 2).Select
Case "P"
'Text: Problemspeicher nach unten suchen
EZ = Cells(12, 2).End(xlDown).Row '8
If Trim(Cells(EZ, 2)) = "Problemspeicher" Then
'Es wurden noch keine Aufgaben eingetragen
EZ = UF_neueZeile(EZ + 1, True)
Cells(EZ, 2).Select
Else
EZ = Cells(EZ, 2).End(xlDown).Row
If Trim(Cells(EZ, 2)) = "Problemspeicher" Then
EZ = UF_neueZeile(EZ + 1, True)
Cells(EZ, 2).Select
Else
MsgBox "Kann Text: -Problemspeicher- nicht finden"
End If
End If
Case Else
' Exit Sub
End Select
Application.ScreenUpdating = True
End Sub