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

[Rabe]

Hi,

ich habe eine Ergebnis-Matrix (mit im Original MMULT()-Formel) in der Mitarbeitern gewisse Maßnahmen zugeordnet werden.

Mit VBA-Makro erstelle ich pro Mitarbeiter je ein Schulungsblatt (und auch für alle MA) und pro Maßnahme ein Teilnehmerblatt. Immer der MA, in dessen Zeile sich der Cursor befindet und die Maßnahme, in deren Spalte er ist.

Wenn ein Mitarbeiter schon an einer Schulung teilgenommen hat, wird diese Schulung nicht mehr in seinem Blatt aufgezählt. Gelöst durch ein Controlling-Blatt mit eingetragenem Schulungsdatum.

Neue Idee:
Nun soll aber in dem Schulungsblatt des Mitarbeiters diese Schulung trotzdem auftauchen mit dem Datum aus dem Controlling-Blatt in Spalte F.
Meinen Versuch habe ich auskommentiert, da es nicht geklappt hat.

Wie kann das gelöst werden?
Hier die Datei mit den Makros:

  Maßnahmenplanung AS&Q - in Arbeit.xlsb (Größe: 199,13 KB / Downloads: 9)

[Helvetier]

Hallo Rabe
Wenn der Anhang das stimmige Resultat ist, funktioniert Dein Makro ohne irgendwelche Änderung!
Wenn nicht, habe ich etwas nicht verstanden.

Nachtrag: Jetzt glaube ich doch eine Unregelmässigkeit gesehen zu haben:
         If .Cells(loZeile, i).Value > 0 And Sheets("Controlling").Cells(loZeile, i) <> "" Then

<> statt =
Gruss

[Rabe]

Hi,

also die Aufgabe ist:

1. Wenn im Blatt "Ergebnis 2" in der Mitarbeiterzeile eine Zahl steht und gleichzeitig im "Controlling" die entsprechende Zelle leer ist, soll in "Vorlage Mitarbeiter" der Name und die Dauer in C und D eingetragen werden.
   
2. Wenn im Blatt "Ergebnis 2" in der Mitarbeiterzeile eine Zahl steht und gleichzeitig im "Controlling" die entsprechende Zelle ein Datum enthält, soll in "Vorlage Mitarbeiter" der Name und die Dauer in C und D und das Datum aus "Controlling" in F eingetragen werden.
   
3. Wenn im Blatt "Ergebnis 2" in der Mitarbeiterzeile eine Zahl steht und gleichzeitig im "Controlling" die entsprechende Zelle einen "-"enthält", soll nichts in "Vorlage Mitarbeiter" eingetragen werden.
   

Bisheriges Ergebnis bei MA1VN1 (Cursor in eine beliebige Zelle in B4:CW4; Klick auf "Mitarbeiter-Blatt ausdrucken"):

• Mit "=" im Controlling-Teil wird die Maßnahme mit Datum übersprungen und steht dann nicht im Mitarbeiter-Blatt, dort sind dannn 5 Maßnahmen.
  
• Bei "<>" wird nur die Maßnahme mit Datum eingetragen (1 Maßnahme)
  
• Bei einem "-" in der "Controlling"-Zelle (das bedeutet einer 0 in "Ergebnis 2") wird die jeweilige Maßnahme immer ausgelassen (das ist korrekt).
  

Es sollen aber 6 Maßnahmen in dieser Reihenfolge sein:

• 2 ohne Datum (Schulung xy, Untersuchung G8),
  
• 1 mit Datum (Untersuchung G9),
  
• 3 ohne Datum (Untersuchung G10, Untersuchung G12, 100)
  

Wenn ich auch den auskommentierten Code-Teil der IF-Schleifen verwende, wird nur die "Untersuchung G9" sowie "100" eingetragen. Ich suche also eine Verknüpfung der beiden ersten Punkte (= und <>) im bisherigen Ergebnis, der dritte Punkt ("-") passt ja.

   'Nun werden die Maßnahmen (Spaltenbezeichnungen aus Zeile 3) ohne Lücken in das Mitarbeiter-Blatt eingetragen! 
   With Sheets(strErgebnis)
      j = loMaßnahmeStart
      For i = loMatrixStart To loMatrixEnde
         If .Cells(loZeile, i).Value > 0 And Sheets("Controlling").Cells(loZeile, i) = "" Then
            ActiveSheet.Range("C" & j) = .Cells(3, i)
            ActiveSheet.Range("D" & j).FormulaR1C1 = _
                "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
'         End If 
'         If .Cells(loZeile, i).Value > 0 And Sheets("Controlling").Cells(loZeile, i) <> "" 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

[Helvetier]

Hallo Ralf
Mit Deinen Ausführungen wird die Sache transparent!
Ich bin eigentlich sicher, dass uns die verschachtelten if - Bedingungen einen Streich spielen: > and = und > and <>.
Versuch doch mal die Bedingungen zu entflechten:
 If > then
   if=the
resp.
if > then
   if <> then

Ein Fehler lässt sich so mit der F - Taste eher finden
Oder versuch mit Select case zu arbeiten. Auch das gibt eine Entflechtung der Bedingungen.
Gruss

[Rabe]

Hi,

super, danke, so funktioniert es korrekt:

      'Nun werden die Maßnahmen (Spaltenbezeichnungen aus Zeile 3) ohne Lücken in das Mitarbeiter-Blatt eingetragen! 
      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
            If Sheets("Controlling").Cells(loZeile, i) = "" Then
               ActiveSheet.Range("C" & j) = .Cells(3, i)
               ActiveSheet.Range("D" & j).FormulaR1C1 = _
                   "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
            End If
            If Sheets("Controlling").Cells(loZeile, i) <> "" 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)
            End If
            j = j + 1
         End If
      Next i
      End With

und so auch

   'Nun werden die Maßnahmen (Spaltenbezeichnungen aus Zeile 3) ohne Lücken in das Mitarbeiter-Blatt eingetragen! 
   With Sheets(strErgebnis)
      j = loMaßnahmeStart
      For i = loMatrixStart To loMatrixEnde
         If .Cells(loZeile, i).Value > 0 Then
            If Sheets("Controlling").Cells(loZeile, i) = "" Then
               ActiveSheet.Range("C" & j) = .Cells(3, i)
               ActiveSheet.Range("D" & j).FormulaR1C1 = _
                   "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
            Else
               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)
            End If
            j = j + 1
         End If
      Next i
   End With

[Helvetier]

Hallo
Freiwillige Kosmetik:
Gruss

Code:

'Nun werden die Maßnahmen (Spaltenbezeichnungen aus Zeile 3) ohne Lücken in das Mitarbeiter-Blatt eingetragen!
     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
           If Sheets("Controlling").Cells(loZeile, i) = "" Then
              ActiveSheet.Range("C" & j) = .Cells(3, i)
              ActiveSheet.Range("D" & j).FormulaR1C1 = _
                  "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
           'End If
           Else
           'If Sheets("Controlling").Cells(loZeile, i) <> "" 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)
           End If
           j = j + 1
        End If
     Next i
     End With

[Helvetier]

Hallo Ralf
Und jetzt gibt es bald den Schönheitspreis:

Code:

'Nun werden die Maßnahmen (Spaltenbezeichnungen aus Zeile 3) ohne Lücken in das Mitarbeiter-Blatt eingetragen!
     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 Sheets("Controlling").Cells(loZeile, i) = "" Then
               ActiveSheet.Range("C" & j) = .Cells(3, i)
               ActiveSheet.Range("D" & j).FormulaR1C1 = _
                   "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
               If .Cells(loZeile, i).Value <= 0 Then
                   ActiveSheet.Range("F" & j) = Sheets("Controlling").Cells(loZeile, i)
               End If
               j = j + 1
           End If
     Next i
     End With

[snb]

Verwende Arrays.
Verzichte auf ExcelFormeln in VBA:

Code:

Sub ControllingBlatt_anlegen()
   sn = Sheets("Ergebnis 2").Range("B2:CW103")
   
   With Sheets("Controlling")
      .Range("A4:A103").Value = Sheets("Ergebnis 2").Range("A4:A103").Value
      .Range("B3:CW3").Value = Sheets("Ergebnis 2").Range("B3:CW3").Value
      sp = .Range("B2:CW103")

      For j = 1 To UBound(sp)
        For jj = 1 To UBound(sp, 2)
          If Not IsDate(sp(j, jj)) Then sp(j, jj) = IIf(sn(j, jj) = 0, "-", sn(j, jj))
        Next
      Next

      .Range("B2:CW103") = sp
    End With
End Sub

[Rabe]

Hi,

Und jetzt gibt es bald den Schönheitspreis:

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

[Rabe]

Hi snb,

Verwende Arrays.
Verzichte auf ExcelFormeln in VBA:

kannst Du mir für die IFERROR(VLOOKUP...) Formeln auch die Array-Lösung zeigen?

Code:

Sub MitarbeiterBlatt_anlegen()
  '
  'Variablen im mdl_Variablen
  '
  'Konstanten
  strVorlage = "Vorlage Mitarbeiter"
  loMatrixStart = 2
  loMatrixEnde = 103
  loMaßnahmeStart = 9
  '
 
  With Application
     .ScreenUpdating = False
     .EnableEvents = False
  End With
 
  '   If ActiveCell.Column <> 1 Then Exit Sub
  '   strAuswahl = ActiveCell.Value
  If ActiveCell.Row < 4 Then Exit Sub
  strAuswahl = Cells(ActiveCell.Row, 1).Value
 
  Sheets(strVorlage).Visible = True
  Sheets(strVorlage).Select
  Sheets(strVorlage).Copy Before:=Sheets(3)
 
  Range("C3").Value = strAuswahl
  Range("H1") = Date
 
  loZeile = Application.Match(strAuswahl, Sheets(strErgebnis).Columns(1), 0)
  '
  'Range("C3").Value = strAuswahl ' & ", " & Sheets(strMitarbeiter).Range("B" & loZeile).Value
  'strAuswahl = Range("C3").Value
  ActiveSheet.Name = strAuswahl
  'Range("G3").Value = Sheets(strMitarbeiter).Range("B" & loZeile).Value         'Kürzel
  Range("C5").Value = Sheets(strMitarbeiter).Range("C" & loZeile).Value         'Bereich
 
  '   Sheets(strVorlage).Visible = False
 
     'Nun werden die Maßnahmen (Spaltenbezeichnungen aus Zeile 3) ohne Lücken in das Mitarbeiter-Blatt eingetragen!
     With Sheets(strErgebnis)
        j = loMaßnahmeStart
        For i = loMatrixStart To loMatrixEnde
           If .Cells(loZeile, i).Value > 0 Then
              If Sheets("Controlling").Cells(loZeile, i) = "" Then
                 ActiveSheet.Range("C" & j) = .Cells(3, i)
                 ActiveSheet.Range("D" & j).FormulaR1C1 = _
                         "=IFERROR(VLOOKUP(RC3,Maßnahmenzuordnung!R4C1:R103C3,3,0),"""")"
              Else
                 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)
              End If
              j = j + 1
           End If
        Next i
     End With
     
  'Speichern und Ausdrucken des Blattes
  'Call Daten_Export_MA
 
  '   MsgBox ("Das Mitarbeiterblatt wurde abgelegt und ausgedruckt!")
  With Application
     .ScreenUpdating = True
     .EnableEvents = True
  End With
 
End Sub