aus Matrix (Mitarbeiter/Maßnahme) einen Maßnahmenplan erstellen

[Helvetier]

da wird dann wieder die Maßnahme weggelassen, die ein Datum hat.

Hallo Ralf, da ist überhaupt nichts weggelassen nur etwas anders geordnet. Das Resultat ist das gleich. Deswegen schreibe ich von Kosmetik.
If Sheets("Controlling").Cells(loZeile, i) = "" Then
verlangt nach
ActiveSheet.Range("C" & j) = .Cells(3, i)
               ActiveSheet.Range("D" & j).FormulaR1C1 = _
                   "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
Else verlangt nach demselben
ActiveSheet.Range("C" & j) = .Cells(3, i)
               ActiveSheet.Range("D" & j).FormulaR1C1 = _
                   "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
Also kann man dies unter einen Hut nehmen.
Und zwar vor If Sheets("Controlling").Cells(loZeile, i) = "" Then

Gruss

[Rabe]

Hi,

Hallo Ralf, da ist überhaupt nichts weggelassen nur etwas anders geordnet. Das Resultat ist das gleich. Deswegen schreibe ich von Kosmetik.

ich habe den Makroteil in die Testdatei reingeschrieben und es werden im Mitarbeiterblatt wieder nur die 5 Maßnahmen ohne das Datum angezeigt und nicht die 5 ohne und die eine Maßnahme mit Datum. Also wurde diese Maßnahme vom Makro weggelassen.

[snb]

So geht das:

Code:

Sub MitarbeiterBlatt_anlegen()
   sp = Sheets("controlling").Cells(1).CurrentRegion
   sq = Sheets("Maßnahmenzuordnung").Range("A1:CY103")
   
   sn = Sheets("Ergebnis 2").Cells(1).CurrentRegion
   y = ActiveCell.Row
   
   For jj = 2 To UBound(sn, 2)
      If sn(y, jj) <> "" And sp(y, jj) = "" Then c01 = c01 & "_" & sn(3, jj) & "|" & sq(jj + 2, 3)
   Next
   st = Split(Mid(c01, 2), "_")
   ReDim sr(UBound(st), 1)
   For j = 0 To UBound(sr)
      y = InStr(st(j), "|")
      sr(j, 0) = Left(st(j), y - 1)
      sr(j, 1) = Mid(st(j), y + 1)
   Next
   
   With Tabelle12
    .Visible = True
    .Copy , Sheets(Sheets.Count)
    .Visible = 2
   End With
   
   With Sheets(Sheets.Count)
       .Name = sn(y, 1)
       .Cells(3, 3) = .Name
       .Cells(1, 8) = Date
       .Cells(9, 3).Resize(UBound(sr) + 1, 2) = sr
   End With
End Sub

NB. Im Blatt Massnahmenzuordnung fehlt ein Termin bei Massnahme 100, obwohl die für MA1 indiziert ist.

[Helvetier]

ich habe den Makroteil in die Testdatei reingeschrieben und es werden im Mitarbeiterblatt wieder nur die 5 Maßnahmen ohne das Datum angezeigt und nicht die 5 ohne und die eine Maßnahme mit Datum. Also wurde diese Maßnahme vom Makro weggelassen.

Hallo Rabe
Natürlich hast Du recht. Der getestete Code lautet so:
Gruss

Code:

   With Sheets(strErgebnis)
        'loLetzte = .Cells(Rostr.Count, 2).End(xlUp).Row           ' letzte belegte in Spalte B (2)
       j = loMaßnahmeStart
       For i = loMatrixStart To loMatrixEnde
           If .Cells(loZeile, i).Value > 0 Then
               ActiveSheet.Range("C" & j) = .Cells(3, i)
               ActiveSheet.Range("D" & j).FormulaR1C1 = _
                   "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
               If Sheets("Controlling").Cells(loZeile, i) <> "" Then
                   ActiveSheet.Range("F" & j) = Sheets("Controlling").Cells(loZeile, i)
               End If
               j = j + 1
           End If
     Next i
   End With

[snb]

Etwas verbessert:

Code:

Sub MitarbeiterBlatt_anlegen()
   sn = Sheets("Ergebnis 2").Range("A1:CY103")
   sp = Sheets("controlling").Range("A1:CY103")
   sq = Sheets("Maßnahmenzuordnung").Range("A1:CY103")
   ReDim st(24, 1)
   y = ActiveCell.Row
   
   For j = 2 To UBound(sn, 2)
      If sn(y, j) <> "" And sp(y, j) = "" Then
        st(x, 0) = sn(3, j)
        st(x, 1) = sq(j + 2, 3)
        x = x + 1
      End If
   Next
      
   With Tabelle12
    .Visible = True
    .Copy , Sheets(Sheets.Count)
    .Visible = 2
   End With
   
   With Sheets(Sheets.Count)
       .Name = sn(y, 1)
       .Cells(3, 3) = .Name
       .Cells(1, 8) = Date
       .Range("C9:D33") = st
   End With
End Sub

[Rabe]

Hi snb,

danke auch für Deinen Code.
Hier das Ergebnis im Vergleich zu dem von Helvetier.
snb:
   

Helvetier (das war mein Ziel):
   

[Rabe]

Hi,

Natürlich hast Du recht. Der getestete Code lautet so:

ich hatte eben noch einen Geistesblitz, nun noch kürzer:

Code:

With Sheets(strErgebnis)
      j = loMaßnahmeStart
      For i = loMatrixStart To loMatrixEnde
         If .Cells(loZeile, i).Value > 0 Then
            ActiveSheet.Range("C" & j) = .Cells(3, i)
            ActiveSheet.Range("D" & j).FormulaR1C1 = _
                "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
            ActiveSheet.Range("F" & j) = Sheets("Controlling").Cells(loZeile, i)
            j = j + 1
         End If
      Next i
   End With

Da ja bei "> 0" die korrespondierende Zelle im Controlling-Blatt immer ein Datum enthält oder leer ist.

[Helvetier]

Glückwunsch! Ganz nach dem Motto: Perfekt ist etwas, wenn man nichts mehr weglassen kann (ohne die Funktion zu beeinträchtigen).

Übrigens: snb bringt unten die intellektuelle Lösung während Du nun die für Jedermann nachvollziehbare Handwerkerlösung hast: kannst wählen!

[snb]

Dann reicht doch:

Code:

Sub MitarbeiterBlatt_anlegen()
   sn = Sheets("Ergebnis 2").Range("A1:CY103")
   sp = Sheets("controlling").Range("A1:CY103")
   sq = Sheets("Maßnahmenzuordnung").Range("A1:CY103")
   ReDim st(24, 4)
   y = ActiveCell.Row
   
   For j = 2 To UBound(sn, 2)
      If sn(y, j) <> 0 Then
        st(x, 0) = sn(3, j)
        st(x, 1) = sq(j + 2, 3)
        If sp(y, j) <> "" Then st(x, 3) = sp(y, j)
        x = x + 1
      End If
   Next
      
   With Tabelle12
    .Visible = -1
    .Copy , Sheets(Sheets.Count)
    .Visible = 2
   End With
   
   With Sheets(Sheets.Count)
       .Name = sn(y, 1)
       .Cells(3, 3) = .Name
       .Cells(1, 8) = Date
       .Range("C9:F33") = st
   End With
End Sub

NB. Es wäre überhaupt sinnvoll Beispeile zu zeigen die das erwartete Ergebnis beinhalten.

[snb]

Wenn auch die Maßnahmenblätter erstellt werden müssen:

Code:

Sub M_snb()
   sn = Sheets("Ergebnis 2").Range("A1:CY103")
   sp = Sheets("controlling").Range("A1:CY103")
   sq = Sheets("Maßnahmenzuordnung").Range("A1:CY103")
   ReDim st(24, 4)
   y = ActiveCell.Row
   
   For j = 2 To UBound(sn, 2)
      If sn(y, j) <> 0 Then
        st(x, 0) = sn(3, j)
        st(x, 1) = sq(j + 2, 3)
        If sp(y, j) <> "" Then st(x, 3) = sp(y, j)
        x = x + 1
      End If
      
      sr = st
      Z = 0
      For jj = 4 To UBound(sn)
         If sn(jj, j) <> 0 Then
           sr(Z, 0) = sn(jj, 1)
           sr(Z, 1) = sq(j + 2, 3)
           Z = Z = 1
         End If
      Next
      If Z > 0 Then
         With Tabelle14    ' Maßnahmenblatt
            .Visible = -1
            .Copy , Sheets(Sheets.Count)
            .Visible = 2
        End With
        
        With Sheets(Sheets.Count)
            .Name = sn(3, j)
            .Cells(3, 3) = .Name
            .Cells(1, 8) = Date
            .Range("C9:D33") = sr
        End With
      End If
   Next
      
   With Tabelle12    ' Mitarbeiterblatt
    .Visible = -1
    .Copy , Sheets(Sheets.Count)
    .Visible = 2
   End With
   
   With Sheets(Sheets.Count)
       .Name = sn(y, 1)
       .Cells(3, 3) = .Name
       .Cells(1, 8) = Date
       .Range("C9:F33") = st
   End With
End Sub