Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Kapazitätenplanung

Betrifft: Kapazitätenplanung von: freeman
Geschrieben am: 08.09.2014 13:55:12

Hallo zusammen,

ich habe ein kleines problemchen. Ich darf eine Kapazitätenliste mit VBA erstellen, habe aber nur Grundkenntnisse und komme einfach nicht weiter.

Das Problem, an dem ich gerade dran bin ist die "Namenserkennung".
Einem Projekt kann zu jeder der 7 Phasen ein Name zugeordnet werden. Natürlich gibt es mehrere Projekte und jeder Name kann beliebig oft verwendet werden.
Aufgrund der unterschiedlichen Belastung ergibt sich für jede Person ein individueller Belastungwert (die Berechnung spielt jetzt mal koch keine Rolle...). In einer separaten Liste sollen alle Personen, die an Projekten mitarbeiten, aufgelistet werden, natürlich nur 1x (und dann kumuliert der Belastungswert angegeben, was aber wie gesagt für den Moment noch egal ist). Es geht um diese Auflistung.
Ich habs bisher zu programmiert, dass das Programm alle Zellen durchgeht, in denen Namen stehen, und dann die Namen in der seperaten Liste ausgegeben werden. Es wird also quasi die Namenreihenfolge aufgelistet, sodass dieselbe Person sooft in der Liste vorkommt, wie sie bei den Projekten eingetragen sind, was ja nicht Sinn der Sache sein soll.

Ich weiß das klingt etwas kompliziert, ich habe versucht, den Sachverhalt so gut es ging hier zu beschreiben und hoffe sehr, dass mir jemand helfen kann.

Hier sind ein paar Screenshots. Einer, wenn unterschiedliche Namen eingegeben werden, einer mit gleicher Namensnennung und doppelter Nennung in der Liste und ein "frisierter", wie der Optimalfall aussehen sollte. https://www.herber.de/bbs/user/92523.zip

Zudem ist hier noch die Originaldatei.
https://www.herber.de/bbs/user/92524.xlsm

Viele Grüße


  

Betrifft: AW: Kapazitätenplanung von: fcs
Geschrieben am: 08.09.2014 16:57:08

Hallo Freeman,

mit dem Projekt hast du dir aber so einigfes vorgenommen.

Um doppelte Listung der Namen zu verhindern, muss bei jedem Namen - außer dem ersten- geprüft werden, ob er schon in der Liste vorhanden ist.
Du musst die Namensliste aber noch an einer anderen Posiion einfügen - am besten separates Blatt. Wenn die Anzahl der Projekte größer wird, dann überlappt sie mit den Einträgen der Phase 7.

Gruß
Franz

Sub tabelle()

Dim anzahlProjekte As Integer
Dim erstesJahr As Integer
Dim monate As Integer
Dim anzahlNamen As Integer
Dim j As Integer
Dim p As Integer
Dim q As Integer
Dim w As Integer
Dim name As String
Dim r As Integer
Dim c As Integer



Set sheet1 = ThisWorkbook.Worksheets("Tabelle1")


anzahlProjekte = Application.WorksheetFunction.CountA(sheet1.Range("A13:A1000"))

'MsgBox anzahlProjekte


monate = sheet1.Cells(13, Columns.Count).End(xlToLeft).Column - 11

'MsgBox monate


anzahlName = sheet1.Cells(13, Columns.Count).End(xlToLeft).Column - 3

'MsgBox anzahlName

'Löschen der Werte in der Tabelle

For j = 13 To (anzahlProjekte + 13)
   
   For p = 12 To (monate + 12)
   
          sheet1.Cells(j, p).Clear
   
   Next
   
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 + 3)
   
            With sheet1
                name = sheet1.Cells(q, w).Value
   
                'MsgBox name
                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
    
End Sub



  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 09.09.2014 08:04:21

Lieber Franz,

vielen vielen Dank, das hilft mir schonmal gut weiter :)


  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 09.09.2014 16:45:13

So ihr Lieben,

ich hab ein weiteres Problem. Das betrifft jetzt die Berechnung der einzelnen Werte bzw. eher die Ausgabe dieser Werte.

Es werden nun die Werte aus Anteil am Grundprojekt mal den entsprechenden "Monatsbelastungswert" aus einer Tabelle (am oberen Rand auf angehängtem Bild https://www.herber.de/bbs/user/92553.zip ) berechnet und dann in die Zeile des entsprechenden Projektes eingefügt.
Beim ersten Projekt klappt das ja wunderbar, aber beim zweiten versetzt es die Werte nach rechts.

Hier mal noch den Programmcode:

c = 12

For a = 13 To (anzahlProjekte + 12)

anzTage = sheet1.Cells(a, 2).Value - sheet1.Cells(5, 4).Value

anzMo = anzTage / 30

For b = (62 - anzMo) To 62

wert = Cells(a, 3).Value * Cells(4, b).Value

sheet1.Cells(a, c) = wert

c = c + 1

Next

Next

Das nach rechts Versetzen beim zweiten Projekt kommt wsl. wegen c=c+1 aber ich weiß nicht, wie ich das umgehen kann, damit das Ganze trotzdem klappt.

Hat da jemand eine Lösung dafür?
Wäre sehr dankbar :)

Viele Grüße


  

Betrifft: AW: Kapazitätenplanung von: fcs
Geschrieben am: 10.09.2014 10:29:56

Hallo freeman,

ungetestet:
du musst den Spaltenzähler immer for dem Start der inneren For-Next-Schleife auf 12 zurücksetzen.

Gruß
Franz

For a = 13 To (anzahlProjekte + 12)

anzTage = sheet1.Cells(a, 2).Value - sheet1.Cells(5, 4).Value

anzMo = anzTage / 30

c = 12

For b = (62 - anzMo) To 62

wert = Cells(a, 3).Value * Cells(4, b).Value

sheet1.Cells(a, c) = wert

c = c + 1

Next

Next



  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 10.09.2014 17:05:01

Vielen Dank! Es funktioniert :-)


  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 12.09.2014 10:12:26

So liebe Freunde der VBA Programmierung,

ich bin mittlerweile etwas weiter gekommen habe allerdings jetzt wieder ein größeres Problem, an dem ich gerade verzweifle.

Im Anhang befindet sich die Excel Datei (etwas frisiert, damit es dem Ideal einigermaßen nahe kommt).

https://www.herber.de/bbs/user/92591.xlsm


Nochmal kurz zur Gesamtaufgabe:

Es gibt mehrere Projekte, denen Personen in fünf verschiedenen Phasen zugeteilt werden können. Jede Phase (in der Tabelle 5A-5H benannt) hat eine gewisse Gewichtung.
Zudem lässt sich der Anteil am Grundprojekt angeben.
Mit Hilfe des Anteils am Grundprojekt und Werten aus einer vorgegebenen Tabelle (Tabelle ganz oben auf dem Blatt) errechnen sich Werte, die dann in der Wertetabelle rechts neben den Namen ausgegeben wird. Das fuktioniert bisher eigentlich alles.
Desweiteren werden die den Projekten zugeteilen Namen (Mehrfachnennung möglich) in eine seperate Liste unterhalb der "Haupttabelle" einfach ausgegeben (was mit Eurer Hilfe geklappt hat :) ). Hier ist allerdings das Problem, dass es mir aus welchen Gründen auch immer eine Leerzeilen (in der Beispieltabelle zwischen "Jo" und "Marlene" reinhaut. Das ist aber nicht das ganz große Problem.

Dieses folgt nun (und ist echt schwer zu erklären, ich hoffe ich bekomms verständlich rüber):

In der seperaten Liste soll nun recht von den Namen personenbezogene Werte berechnet bzw. dort ausgespuckt werden. In der Datei habe ich händisch mal ein paar werte hinter "Jo", "Marlene" und "Marius" eingefügt, die von mir berrechnet wurden. Daher sollte es sich (wenn ich mich nicht verrechnet habe) um die korrekten und wünschenswerten Werte für dieses Beispiel handeln.
Wie sollen diese Werte berechnet werden?
Beispielsweise wird der Wert in L30 (1,86), also der erste Wert rechts neben "Jo", folgendermaßen berechnet: In der "Haupttabelle" (da wo die ganzen Projekte und Namen stehen) soll das Programm nur schauen wo der "Jo" drinsteht, da ja für ihn die Werte in der seperaten Liste ausgegeben werden sollen. Nun soll das Programm die Namensliste durchgehen und da wo "Jo" drinsteht diesen Wert (abhängig von der Projektphase) mit dem Wert in der nebenstehenden Tabelle multiplizieren.
Ich mach mal ein konkretes Beispiel:
In D13 steht "Jo" also soll das Programm 0,45*0,93 (L13) berechnen. Dann geht es weiter. In E13 steht auch "Jo", demnach soll 0,05*0,93 berechnet werden und zur ersten Rechnung dazuaddiert werden usw. .
Die komplette Rechnung für den ersten Wert bei "Jo" in der seperaten Liste sieht also so aus:

0,45*0,93 + 0,05*0,93 + 0,15*0,93 + 0*0,93 + 0,2*0,93 + 0,05*0,93 + 0,1*0,93 (Sprung in die nächste Zeile) + 0,45*0,93 + 0,05*0,93 + 0,15*0,93 + 0*0,93 + 0,2*0,93 + 0,05*0,93 + 0,1*0,93 = 1,86

Hier nochmal ein Beispiel für "Marlene":

(Zeile 15) 0,45*0,635 + 0,05*0,635 + 0,15*0,635 + 0*0,635 + 0,2*0,635 + 0,05*0,635 + 0,1*0,635 +
(Zeile 16: keine Werte, da graues Feld)
(Zeile 19: erst hier kommt "Marlene" wieder vor) 0,05*1,016 + 0,15*1,016 + 0*1,016 + 0,2*1,016 + 0,05*1,016 = 1,0922


Diese Berechnungen sollen nun für alle Namen und alle Werte in der "Haupttabelle" (vom rechten Teil) durchgeführt und unten in der seperaten Namensliste ausgespuckt werden.

In der Datei sind wie gesagt schon ein paar Werte von Hand eingetragen, die eigentlich richtig sein sollten, damit Ihr ein paar weitere Beispielwerte habt.

Ich hoffe, dass ich es einigermaßen verständlich rübergebracht habe. Ist ziemlich kompliziert und für mich als Anfänger nicht ganz einfach zu bewältigen. Deshalb wäre es top, wenn Ihr als Profis eine Lösung hättet.
Generell könnt Ihr auch gerne mal über den restlichen Programmcode drüberschauen und falls Ihr manche Sachen besser machen würdet dies verbessern.

Viele Grüße :)




  

Betrifft: AW: Kapazitätenplanung von: fcs
Geschrieben am: 12.09.2014 15:33:28

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



  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 15.09.2014 08:33:53

Vielen Dank Franz :)

Jetzt nur noch eine Sache. Ich hab das getestet, aber in meiner seperaten Liste gibts mir keine Werte aus...

https://www.herber.de/bbs/user/92626.zip

Viele Grüße


  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 15.09.2014 08:49:09

Ah dazu sei noch erwähnt... Die Namen der seperaten Liste stehen jetzt in Spalte 11 also ab K30...sry hab ich nicht erwähnt...


  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 15.09.2014 15:14:53

Sodele

tut mir Leid. Kommando zurück. Also ich habs mal anders eingefügt. Jetzt funktionierts. Das ist der Wahnsinn :D Hätte ich nie hinbekommen! Danke!!!

Aber wie es so oft ist, wenn ein Problem gelöst wird, kommt das nächste schon bald wieder.

Wenn ich jetzt viele Projekte eingebe, dann kommen sich irgendwann meine Projektliste und die seperate Liste in die Quere. Deshalb hatte ich die Idee, die seperate Liste immer in einem kostanten Abstand (z.B. 5 Zeilen) "weiterlaufen" zu lassen.
Das hab ich auch z.T. hinbekommen, aber irgendwann hauts mir dann die Tabelle auseinander bzw. es stehen Zahlen in Feldern, wo keine stehen dürften.
Ich hab leider nicht das geschulte Auge dazu, um die Details bei so viel Programmcode zu erkennen, worans noch hakt.
Da ihr aber Profis seid, könnt ihr das bestimmt. Wäre euch sehr dankbar ;)

https://www.herber.de/bbs/user/92642.zip
https://www.herber.de/bbs/user/92643.xlsm

Viele Grüße


  

Betrifft: AW: Kapazitätenplanung von: freeman
Geschrieben am: 16.09.2014 17:26:15

Hallöle :)

Neues Problem: Diagramm mit Hilfe von VBA erstellen...

Wie kann ich im Code darstellen welche Linienfarbe die Linien im Diagramm haben?
Und wie bekomm ichs hin, dass mir das Diagramm die einzelnen Werte aus je einer Zeilen abbildet und nicht Zeile für Zeile aufkumuliert?
Ich habe schon etwas, aber das ist eigentlich mehr zum ausprobieren gewesen.

So siehts gerade aus...
https://www.herber.de/bbs/user/92666.zip


Mein bisheriger Code:

Sub Diagramm_erstellen()

Dim anzahlNamen As Integer
Dim monate As Integer
Dim anzahlProjekte As Integer
Dim y As Integer

Set sheet1 = ThisWorkbook.Worksheets("Tabelle1")







'Bestimmung Anzahl der Monate

monate = sheet1.Cells(11, Columns.Count).End(xlToLeft).Column - 11



'Bestimmung Anzahl der Projekte
anzahlProjekte = Application.WorksheetFunction.CountA(Range("A13:A1000"))


'Anzahl der Namen

y = 13 + anzahlProjekte + 10

anzahlNamen = 0

Do While Cells(y, 11).Value <> 0

anzahlNamen = anzahlNamen + 1

y = y + 1

Loop


'MsgBox anzahlNamen






    ActiveSheet.Shapes.AddChart.Select
    
    'ActiveChart.SetSourceData Source:=Range("'Tabelle1'!$K$26:$AY$27")
    
    ActiveChart.SetSourceData Source:=Range(Cells(13 + anzahlProjekte + 10, 11), Cells(13 +  _
anzahlProjekte + 10 - 1 + anzahlNamen, monate + 11))
    
    
    ActiveChart.ChartType = xlLineMarkers
    


'Diagrammgröße
Worksheets(1).ChartObjects(1).Height = Application.CentimetersToPoints(10)

Worksheets(1).ChartObjects(1).Width = Application.CentimetersToPoints(15)



ActiveSheet.ChartObjects(1).Activate
  With ActiveChart.ChartArea
    With ActiveChart.SeriesCollection(1)
      With Selection.Border
          .ColorIndex = 1
          .Weight = xlThick
          .LineStyle = xlContinuous
      End With
      
      With Selection.Interior
      .ColorIndex = 7
      End With
      
    End With
  End With




End Sub


Hat jemand von euch Erfahrung mit Diagrammerstellung mit VBA?

Viele Grüße