AW: Kapazitätenplanung
12.09.2014 15:33:28
fcs
Hallo Freeman,
die Leerzeile in der Liste der Namen taucht auf, weil du die Anzahl der Namen nicht korrekt ermittelst und weil der Endwert für den Schleifenzähler nicht korrekt gesetzt wird. Dadurch sind leere Zellen im auszuwertenden Zellbereich.
Damit das Problem beseitigt wird müssen 3 Zeilen geändert/ergänzt werden. Siehe markierte Zeilen im Code
Die zu berechnenden Werte kann man per Formel berechnen.
Nachfolgend ein Makro das die Formeln im Bereich einfügt und durch die Werte ersetzt.
Gruß
Franz
Sub SOPerstellung()
Dim anzahlProjekte As Integer
Dim erstesJahr As Integer
Dim monate As Integer
Dim anzahlNamen As Integer
Dim name As String
Dim anzahlJahre As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim o As Integer
Dim p As Integer
Dim q As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim u As Integer
Dim v As Integer
Dim w As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim anzTage As Integer
Dim anzMo As Integer
Dim start As Date
Dim wert As Double
Dim SOPinMonth As Integer
Dim summe As Double
Set sheet1 = ThisWorkbook.Worksheets("Tabelle1")
'Bestimmung Anzahl der Projekte
anzahlProjekte = Application.WorksheetFunction.CountA(Range("A13:A1000"))
'MsgBox anzahlProjekte
'Bestimmung Anzahl der Monate
monate = sheet1.Cells(13, Columns.Count).End(xlToLeft).Column - 11
'MsgBox monate
'Bestimmung Anzahl der Namen
anzahlName = sheet1.Cells(13, Columns.Count).End(xlToLeft).Column - 4 'Korrektur!!! 2014-09- _
12
'MsgBox anzahlName
'Berechnung Anzahl der Jahre
anzahlJahre = monate / 12
'Bestimmung des ersten Jahres
erstesJahr = sheet1.Cells(10, 12).Value
'MsgBox erstesJahr
'Löschen der Werte in der Tabelle
For j = 13 To (anzahlProjekte + 12)
For p = 12 To 215
sheet1.Cells(j, p).Clear
sheet1.Cells(j, p).Interior.ColorIndex = 2
sheet1.Cells(j, p).BorderAround ColorIndex:=1, Weight:=xlThin
Next
Next
'Überwachung ob SOP eingetragen ist
For y = 13 To (anzahlProjekte + 12)
If Cells(y, 2).Value = "" Then
sheet1.Cells(y, 2).Interior.ColorIndex = 46
MsgBox "Bitte SOP in Zelle B" & y & " eintragen.", vbExclamation, "Achtung Pflichtfeld"
Else
sheet1.Cells(y, 2).Interior.ColorIndex = 2
sheet1.Cells(y, 2).BorderAround ColorIndex:=1, Weight:=xlThin
End If
Next
'Erzeugung der Namen
With sheet1
'alte Namensliste ggf. löschen
r = .Cells(.Rows.Count, 10).End(xlUp).Row
If r >= 30 Then
.Range(.Cells(30, 10), .Cells(r, 10)).ClearContents
End If
End With
r = 30
For q = 13 To (anzahlProjekte + 12)
For w = 4 To (anzahlName - 1) 'Korrektur!!! 2014-09-12
With sheet1
name = sheet1.Cells(q, w).Value
'MsgBox name
If name = "" Then GoTo Next_w_Name 'NEU!!! 2014-09-12
If r > 30 Then
'Prüfen, ob Name schon in Liste vorhanden
If Application.WorksheetFunction.CountIf(.Range(.Cells(30, 10), _
.Cells(r - 1, 10)), name) > 0 Then
'Name überspringen
GoTo Next_w_Name
End If
End If
.Cells(r, 10).Value = name
r = r + 1
End With
Next_w_Name:
Next
Next
'Berechnung der Werte und Einfügen in der Tabelle
For a = 13 To (anzahlProjekte + 12)
SOPinMonth = ((Year(Cells(a, 2).Value)) - erstesJahr) * 12 + Month(Cells(a, 2).Value)
'MsgBox SOPinMonth
c = (12 + SOPinMonth)
For b = 62 To (62 - (SOPinMonth - 1)) Step -1
If b >= 14 Then
wert = Cells(a, 3).Value * Cells(4, b).Value
'MsgBox wert
sheet1.Cells(a, c - 1) = wert
sheet1.Cells(a, c - 1).BorderAround ColorIndex:=1, Weight:=xlThin
If c = (12 + SOPinMonth) Then
sheet1.Cells(a, c - 1).Interior.ColorIndex = 3
End If
c = c - 1
End If
Next
Next
For d = 13 To (anzahlProjekte + 12)
For e = 12 To 215
If Cells(d, e).Value = "" Then
sheet1.Cells(d, e).Interior.ColorIndex = 16
sheet1.Cells(d, e).BorderAround ColorIndex:=1, Weight:=xlThin
End If
Next
Next
End Sub
Sub fncFormel()
'Berechnung der zusätzlichen Werte zu den Namen
Dim wks As Worksheet
Dim ZeiProj1 As Long, ZeiProjL As Long, ZeiName1 As Long, ZeiNameL As Long
Dim SpaPhase1 As Long, SpaPhaseL As Long
Dim SpaNamen As Long, SpaMonat1 As Long, SpaMonatL As Long
Dim strFormel
Set wks = Worksheets("Tabelle1")
With wks
ZeiProj1 = 13 'Zeile des 1. Projekts
ZeiProjL = .Cells(.Rows.Count, 1).End(xlUp).Row 'Zeile letztes Projekt
SpaPhase1 = 4 'Spalte D - Spalte 1. Phase
SpaPhaseL = 10 'Spalte J - Spalte Letzte Phase
SpaNamen = 10 'Spalte mit den Namen für die die Werte ermittelt werden sollen
ZeiName1 = 30 'Zeile des 1. Namens für den die Werte ermittelt werden sollen
ZeiNameL = .Cells(.Rows.Count, SpaNamen).End(xlUp).Row
SpaMonat1 = 12 'Spalte L - Spalte des 1. Monats
SpaMonatL = .Cells(ZeiProj1 - 2, .Columns.Count).End(xlToLeft).Column 'Letzte Monatsspalte
'Formel L30: =SUMMENPRODUKT(($D$12:$J$12)*($D$13:$J$19=$J30)*(L$13:L$19))
strFormel = "=SUMPRODUCT((R" & (ZeiProj1 - 1) & "C" & SpaPhase1 & ":R" _
& (ZeiProj1 - 1) & "C" & SpaPhaseL & ")*(R" & ZeiProj1 & "C4:R" _
& ZeiProjL & "C" & SpaPhaseL & "=RC" & SpaNamen & ")*(R" & ZeiProj1 _
& "C:R" & ZeiProjL & "C))"
With .Range(.Cells(ZeiName1, SpaMonat1), .Cells(ZeiNameL, SpaMonatL))
.FormulaR1C1 = strFormel
.Calculate
.Value = .Value
End With
End With
End Sub