Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Frame
BildScreenshot zu Frame Frame-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema OptionButton
BildScreenshot zu OptionButton OptionButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

VBA-Prozedur zu groß

Betrifft: VBA-Prozedur zu groß von: Nicolai
Geschrieben am: 08.10.2014 12:08:51

Hallo zusammen,

ich habe gerade mein Marko erweitert und dann kamm die Fehlermeldung das die Prozedur zu groß ist.

Ich habe es bereits mit Call Prozedur1... versucht. es hat zwar den Code durchlaufen lassen, allerdings hat er ihn nicht ausgeführt.

Hier der Code:



Private Sub CommandButton1_Click()

Dim index As Long
Dim Mitarbeiter
Dim Tage As Integer
Dim dat As Date
Dim datmon As String
Dim Zeile, spalte As Integer

Set d2 = UserForm2

 
 'Ermitteln des Abwesenheitsgrundes
 If d2.OptionButton1.Value = True Then
 akennz = 1 'Arbeitsvorbereitung
 ElseIf d2.OptionButton2.Value = True Then
 akennz = 2 'Besprechung
 ElseIf d2.OptionButton3.Value = True Then
 akennz = 3 'Einarbeitung
 ElseIf d2.OptionButton4.Value = True Then
 akennz = 4 'Schulung
 ElseIf d2.OptionButton5.Value = True Then
 akennz = 5 'KVP
 ElseIf d2.OptionButton6.Value = True Then
 akennz = 6 'Erste Hilfe
 ElseIf d2.OptionButton7.Value = True Then
 akennz = 7 'EBA
 ElseIf d2.OptionButton8.Value = True Then
 akennz = 8 'QS
 ElseIf d2.OptionButton9.Value = True Then
 akennz = 9 'BR
 ElseIf d2.OptionButton10.Value = True Then
 akennz = 10 'Anlagenausfall
 ElseIf d2.OptionButton11.Value = True Then
 akennz = 11 'Springer
 ElseIf d2.OptionButton12.Value = True Then
 akennz = 12 'Sonstiges
 ElseIf d2.OptionButton13.Value = True Then
 akennz = 13 'ZE
 ElseIf d2.OptionButton14.Value = True Then
 akennz = 14 'Ebenenwechsel
 ElseIf d2.OptionButton15.Value = True Then
 akennz = 15 'Zusatzpower
 ElseIf d2.OptionButton16.Value = True Then
 akennz = 16 'FreiW Mehrarbeit TZ
 ElseIf d2.OptionButton17.Value = True Then
 akennz = 17 'krank nach Hause
 ElseIf d2.OptionButton18.Value = True Then
 akennz = 18 'Fähigkeitenwerkstatt
' If d2.OptionButton19.Value = True Then akennz = 19 'Mini-CttC
 ElseIf d2.OptionButton20.Value = True Then
 akennz = 20 'ProFit
 ElseIf d2.OptionButton21.Value = True Then
 akennz = 21 'FreiW Mehrarbeit nach Schicht
 ElseIf d2.OptionButton22.Value = True Then
 akennz = 22 'FreiW Mehrarbeit vor Schicht
  ElseIf d2.OptionButton23.Value = True Then
 akennz = 23 'Kal.Mehrarbeit nach Schicht
   ElseIf d2.OptionButton24.Value = True Then
 akennz = 24 'Kal.Mehrarbeit vor Schicht
   ElseIf d2.OptionButton25.Value = True Then
 akennz = 25 'KalMehrarbeit TZ
   ElseIf d2.OptionButton26.Value = True Then
 akennz = 26 'Ang. Mehrarbeit nach Schicht
   ElseIf d2.OptionButton27.Value = True Then
 akennz = 27 'Ang. Mehrarbeit vor Schicht
   ElseIf d2.OptionButton28.Value = True Then
 akennz = 28 'Ang.Mehrarbeit TZ
    ElseIf d2.OptionButton29.Value = True Then
     akennz = 29 'Info Kommentar
 Else
 MsgBox ("Bitte Grund für Eintragung auswählen")
 Exit Sub
 End If
 

 Dim AktZeile As Integer
 Dim AktSpalte As Integer
 AktZeile = ActiveCell.Row
 AktSpalte = ActiveCell.Column
 
 
 If IsNumeric(ActiveCell.Value) = False Then
  MsgBox ("Falsche Zelle - abbrechen")
  Exit Sub
 End If
 
'Info Kommentar
If akennz = 29 And TextBox2.Value = "" Then
 
  
          Dim wert1_29 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_29 As Double
          
          wert1_29 = ActiveCell.Value
          'wert2_29 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
        'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        
        End If
          
ElseIf akennz = 29 And Not (TextBox2.Value = "") Then
 MsgBox ("ungültiger Wert2")
    Exit Sub
ElseIf IsNumeric(TextBox2.Value) = False Or TextBox2.Value < -50 Or TextBox2.Value > 50 Then
        MsgBox ("ungültiger Wert")
    Exit Sub
    

 End If
  

 
 
 'Arbeitsvorbereitung
 If akennz = 1 Then
        
        Dim wert1_1 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5!
        Dim wert2_1 As Double
        Dim com As Comment
        
        wert1_1 = ActiveCell.Value
        wert2_1 = UserForm2.TextBox2.Value
        Kommentartext = UserForm2.TextBox3.Value
        
        'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_1 & " Stunde(n) Arbeitsvorbereitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_1 & " Stunde(n) Arbeitsvorbereitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
        
        'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
        If wert1_1 < 0 Then
            ActiveCell.Value = wert1_1 + wert2_1
        Else
            ActiveCell.Value = wert1_1 - wert2_1
        End If
        
        'Eintrag der Stunden ins Konto Arbeitsvorbereitung
'        If wert1_1 > 10 Then
                Cells(331, ActiveCell.Column) = Cells(331, ActiveCell.Column) + wert2_1
'
'          ElseIf wert1_1 > 0 Then
'                Cells(475, ActiveCell.Column) = Cells(475, ActiveCell.Column) + wert2_1
'
'          Else
'                Cells(495, ActiveCell.Column) = Cells(495, ActiveCell.Column) + wert2_1
'          End If
'
     
  End If
  
    
   'Besprechung
   
  If akennz = 2 Then
          Dim wert1_2 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_2 As Double
          
          wert1_2 = ActiveCell.Value
          wert2_2 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
        'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_2 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_2 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_2 < 0 Then
              ActiveCell.Value = wert1_2 + wert2_2
          Else
              ActiveCell.Value = wert1_2 - wert2_2
          End If
          
          'Eintrag der Stunden ins Konto Besprechung
'          If wert1_2 > 10 Then
                Cells(332, ActiveCell.Column) = Cells(332, ActiveCell.Column) + wert2_2
'
'          ElseIf wert1_2 > 0 Then
'                Cells(476, ActiveCell.Column) = Cells(476, ActiveCell.Column) + wert2_2
'          Else
'                Cells(496, ActiveCell.Column) = Cells(496, ActiveCell.Column) + wert2_2
'          End If
  End If
  
  'Einarbeitung
  If akennz = 3 Then
          Dim wert1_3 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_3 As Double
          
          wert1_3 = ActiveCell.Value
          wert2_3 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                  'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_3 & " Stunde(n) Einarbeitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_3 & " Stunde(n) Einarbeitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_3 < 0 Then
              ActiveCell.Value = wert1_3 + wert2_3
          Else
              ActiveCell.Value = wert1_3 - wert2_3
          End If
          
          'Eintrag der Stunden ins Konto Einarbeitung
'          If wert1_3 > 10 Then
                Cells(333, ActiveCell.Column) = Cells(333, ActiveCell.Column) + wert2_3
                
'          ElseIf wert1_3 > 0 Then
'                Cells(477, ActiveCell.Column) = Cells(477, ActiveCell.Column) + wert2_3
'
'          Else
'                Cells(497, ActiveCell.Column) = Cells(497, ActiveCell.Column) + wert2_3
'          End If
  End If
  
 'Schulung
  If akennz = 4 Then
          Dim wert1_4 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_4 As Double
          
          wert1_4 = ActiveCell.Value
          wert2_4 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                 'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_4 & " Stunde(n) Schulung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & Format(Date, "DD. _
MM.") & " - " & Application.UserName & ": " & wert2_4 & " Stunde(n) Schulung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_4 < 0 Then
              ActiveCell.Value = wert1_4 + wert2_4
          Else
              ActiveCell.Value = wert1_4 - wert2_4
          End If
          
          'Eintrag der Stunden ins Konto Schulung
'          If wert1_4 > 10 Then
                Cells(334, ActiveCell.Column) = Cells(334, ActiveCell.Column) + wert2_4
                
'        ElseIf wert1_4 > 0 Then
'                Cells(478, ActiveCell.Column) = Cells(478, ActiveCell.Column) + wert2_4
'
'          Else
'                Cells(498, ActiveCell.Column) = Cells(498, ActiveCell.Column) + wert2_4
'          End If
  End If
  
  'EO
  If akennz = 5 Then
          Dim wert1_5 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_5 As Double

          wert1_5 = ActiveCell.Value
          wert2_5 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value

                   'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_5 & " Stunde(n) EO " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & Format(Date, "DD. _
MM.") & " - " & Application.UserName & ": " & wert2_5 & " Stunde(n) EO " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

 
        End If

          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_5 < 0 Then
              ActiveCell.Value = wert1_5 + wert2_5
          Else
              ActiveCell.Value = wert1_5 - wert2_5
          End If

          'Eintrag der Stunden ins Konto EO
          
         Cells(348, ActiveCell.Column) = Cells(348, ActiveCell.Column) + wert2_5
         
  End If
'
  'Erste Hilfe
  If akennz = 6 Then
          Dim wert1_6 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_6 As Double
          
          wert1_6 = ActiveCell.Value
          wert2_6 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                 'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_6 & " Stunde(n) Erste Hilfe " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_6 & " Stunde(n) Erste Hilfe " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_6 < 0 Then
              ActiveCell.Value = wert1_6 + wert2_6
          Else
              ActiveCell.Value = wert1_6 - wert2_6
          End If
          
          'Eintrag der Stunden ins Konto Erste Hilfe
'          If wert1_6 > 10 Then
                Cells(335, ActiveCell.Column) = Cells(335, ActiveCell.Column) + wert2_6
'
'          ElseIf wert1_6 > 0 Then
'                Cells(479, ActiveCell.Column) = Cells(479, ActiveCell.Column) + wert2_6
'
'          Else
'                Cells(499, ActiveCell.Column) = Cells(499, ActiveCell.Column) + wert2_6
'          End If
  End If
  
  'EBA
  If akennz = 7 Then
          Dim wert1_7 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_7 As Double
          
          wert1_7 = ActiveCell.Value
          wert2_7 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                  'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_7 & " Stunde(n) EBA " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_7 & " Stunde(n) EBA " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_7 < 0 Then
              ActiveCell.Value = wert1_7 + wert2_7
          Else
              ActiveCell.Value = wert1_7 - wert2_7
          End If
          
          'Eintrag der Stunden ins Konto EBA
'          If wert1_7 > 10 Then
                Cells(336, ActiveCell.Column) = Cells(336, ActiveCell.Column) + wert2_7
'
'          ElseIf wert1_7 > 0 Then
'                Cells(480, ActiveCell.Column) = Cells(480, ActiveCell.Column) + wert2_7
'
'          Else
'                Cells(500, ActiveCell.Column) = Cells(500, ActiveCell.Column) + wert2_7
'          End If
  End If
  
  'QS
  If akennz = 8 Then
          Dim wert1_8 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_8 As Double
          
          wert1_8 = ActiveCell.Value
          wert2_8 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                  'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_8 & " Stunde(n) QS " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_8 & " Stunde(n) QS " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_8 < 0 Then
              ActiveCell.Value = wert1_8 + wert2_8
          Else
              ActiveCell.Value = wert1_8 - wert2_8
          End If
          
          'Eintrag der Stunden ins Konto QK
'          If wert1_8 > 10 Then
                Cells(337, ActiveCell.Column) = Cells(337, ActiveCell.Column) + wert2_8
'
'          ElseIf wert1_8 > 0 Then
'                Cells(481, ActiveCell.Column) = Cells(481, ActiveCell.Column) + wert2_8
'
'          Else
'                Cells(501, ActiveCell.Column) = Cells(501, ActiveCell.Column) + wert2_8
'          End If
  End If
  
  'BR
  If akennz = 9 Then
          Dim wert1_9 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _

          Dim wert2_9 As Double
          
          wert1_9 = ActiveCell.Value
          wert2_9 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                  'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_9 & " Stunde(n) BR " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_9 & " Stunde(n) BR " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_9 < 0 Then
              ActiveCell.Value = wert1_9 + wert2_9
          Else
              ActiveCell.Value = wert1_9 - wert2_9
          End If
          
          'Eintrag der Stunden ins Konto BR
'          If wert1_9 > 10 Then
                Cells(338, ActiveCell.Column) = Cells(338, ActiveCell.Column) + wert2_9
'
'          ElseIf wert1_9 > 0 Then
'                Cells(482, ActiveCell.Column) = Cells(482, ActiveCell.Column) + wert2_9
'
'          Else
'                Cells(502, ActiveCell.Column) = Cells(502, ActiveCell.Column) + wert2_9
'          End If
  End If
  
  'Anlagenausfall
  If akennz = 10 Then
          Dim wert1_10 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_10 As Double
          
          wert1_10 = ActiveCell.Value
          wert2_10 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                  'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_10 & " Stunde(n) Anlagenausfall " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_10 & " Stunde(n) Anlagenausfall " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_10 < 0 Then
              ActiveCell.Value = wert1_10 + wert2_10
          Else
              ActiveCell.Value = wert1_10 - wert2_10
          End If
          
          'Eintrag der Stunden ins Konto Anlagenausfall
'          If wert1_10 > 10 Then
                Cells(339, ActiveCell.Column) = Cells(339, ActiveCell.Column) + wert2_10

'          ElseIf wert1_10 > 0 Then
'                Cells(483, ActiveCell.Column) = Cells(483, ActiveCell.Column) + wert2_10
'
'          Else
'                Cells(503, ActiveCell.Column) = Cells(503, ActiveCell.Column) + wert2_10
'          End If
  End If
  
  'Springer
  If akennz = 11 Then
          Dim wert1_11 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_11 As Double
          
          wert1_11 = ActiveCell.Value
          wert2_11 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
        'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_11 & " Stunde(n) Springer " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_11 & " Stunde(n) Springer " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_11 < 0 Then
              ActiveCell.Value = wert1_11 + wert2_11
          Else
              ActiveCell.Value = wert1_11 - wert2_11
          End If
          
          'Eintrag der Stunden ins Konto Springer
'          If wert1_11 > 10 Then
                Cells(340, ActiveCell.Column) = Cells(340, ActiveCell.Column) + wert2_11
                
'          ElseIf wert1_11 > 0 Then
'                Cells(484, ActiveCell.Column) = Cells(484, ActiveCell.Column) + wert2_11
'
'          Else
'                Cells(504, ActiveCell.Column) = Cells(504, ActiveCell.Column) + wert2_11
'          End If
  End If
  
  'Sonstiges
  If akennz = 12 Then
          Dim wert1_12 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_12 As Double
          
          wert1_12 = ActiveCell.Value
          wert2_12 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_12 & " Stunde(n) Sonstiges " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_12 & " Stunde(n) Sonstiges " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_12 < 0 Then
              ActiveCell.Value = wert1_12 + wert2_12
          Else
              ActiveCell.Value = wert1_12 - wert2_12
          End If
          
          'Eintrag der Stunden ins Konto Sonstiges
'          If wert1_12 > 10 Then
                Cells(341, ActiveCell.Column) = Cells(341, ActiveCell.Column) + wert2_12
                
'          ElseIf wert1_12 > 0 Then
'                Cells(485, ActiveCell.Column) = Cells(485, ActiveCell.Column) + wert2_12
'
'          Else
'                Cells(505, ActiveCell.Column) = Cells(505, ActiveCell.Column) + wert2_12
'          End If
  End If
  
  
  'ZE
  If akennz = 13 Then
          Dim wert1_13 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_13 As Double
          
          wert1_13 = ActiveCell.Value
          wert2_13 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
                 'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_13 & " Stunde(n) ZE " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_13 & " Stunde(n) ZE " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_13 < 0 Then
              ActiveCell.Value = wert1_13 + wert2_13
'              ActiveCell.BorderAround ColorIndex:=5, Weight:=xlMedium

          Else
              ActiveCell.Value = wert1_13 - wert2_13
'              ActiveCell.BorderAround ColorIndex:=5, Weight:=xlMedium

          End If
          
          'Eintrag der Stunden ins Konto ZE
'          If wert1_13 > 10 Then
                Cells(342, ActiveCell.Column) = Cells(342, ActiveCell.Column) + wert2_13
                
'          ElseIf wert1_13 > 0 Then
'                Cells(486, ActiveCell.Column) = Cells(486, ActiveCell.Column) + wert2_13
'
'          Else
'                Cells(506, ActiveCell.Column) = Cells(506, ActiveCell.Column) + wert2_13
'          End If
  End If
  
  
  'Ebenenwechsel
  If akennz = 14 Then
          Dim wert1_14 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_14 As Double
          
          wert1_14 = ActiveCell.Value
          wert2_14 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
               'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_14 & " Stunde(n) Ebenenwechsel " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_14 & " Stunde(n) Ebenenwechsel " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_14 < 0 Then
              ActiveCell.Value = wert1_14 + wert2_14
          Else
              ActiveCell.Value = wert1_14 - wert2_14
          End If
          
          'Eintrag der Stunden ins Konto Ebenenwechsel
'          If wert1_14 > 10 Then
                Cells(343, ActiveCell.Column) = Cells(343, ActiveCell.Column) + wert2_14
'
'          ElseIf wert1_14 > 0 Then
'                Cells(487, ActiveCell.Column) = Cells(487, ActiveCell.Column) + wert2_14
'
'          Else
'                Cells(507, ActiveCell.Column) = Cells(507, ActiveCell.Column) + wert2_14
'          End If
  End If
  
  
  'Zusatzpower gesamt
  If akennz = 15 Then
          Dim wert1_15 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_15 As Double
          
          wert1_15 = ActiveCell.Value
          wert2_15 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
          'Kommentar hinzufügen
          If ActiveCell.Comment Is Nothing Then
                With ActiveCell.AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text " | " & Format(Date, "DD.MM.") & " - " & Application.UserName & ": " & _
 wert2_15 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                End With
          Else
            vorhandener_Kommentar = ActiveCell.Comment.Text
            ActiveCell.Comment.Delete
                With ActiveCell.AddComment
                    .Text vorhandener_Kommentar & " | " & Format(Date, "DD.MM.") & " - " &  _
Application.UserName & ": " & wert2_15 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_15 < 0 Then
              ActiveCell.Value = wert1_15 - wert2_15
          Else
              ActiveCell.Value = wert1_15 + wert2_15
          End If
          
          'Eintrag der Stunden ins Konto Zusatzpower gesamt
'          If wert1_15 > 1000 Then
                Cells(344, ActiveCell.Column) = Cells(344, ActiveCell.Column) + wert2_15
'
'          ElseIf wert1_15 > 0 Then
'                Cells(488, ActiveCell.Column) = Cells(488, ActiveCell.Column) + wert2_15
'
'          Else
'                Cells(508, ActiveCell.Column) = Cells(508, ActiveCell.Column) + wert2_15
'          End If
  End If
  
  
  
  'Freiwillige Mehrarbeit TZ
  
  If akennz = 16 Then
          Dim wert1_16 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_16 As Double
          Dim schließen As Boolean
          
          wert1_16 = ActiveCell.Value
          wert2_16 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
          'Abfrage ob MA TZ ist
          If AktZeile >= 20 And AktZeile <= 140 Then
          MsgBox ("Fehler - TZ MA auswählen")
          schließen = True
          Else
          schließen = False

          End If
                 'Kommentar hinzufügen
        If schließen = True Then
                 
        ElseIf ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_16 & " Stunde(n) FreiW-Mehrarbeit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_16 & " Stunde(n) FreiW-Mehrarbeit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If schließen = True Then
          
          ElseIf wert1_16 < 0 Then
              ActiveCell.Value = wert1_16 - wert2_16
          Else
              ActiveCell.Value = wert1_16 + wert2_16
          End If
          
   End If
  
  'Krank nach Hause
  
  If akennz = 17 Then
          Dim wert1_17 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_17 As Double
          
          wert1_17 = ActiveCell.Value
          wert2_17 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
        'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_17 & " Stunde(n) Krank nach Hause " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_17 & " Stunde(n) Krank nach Hause " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_17 < 0 Then
              ActiveCell.Value = wert1_17 + wert2_17
'              ActiveCell.BorderAround ColorIndex:=45, Weight:=xlMedium

            With Selection.Interior
                .Pattern = xlLightUp
                .PatternColor = 26367
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With


          Else
              ActiveCell.Value = wert1_17 - wert2_17
'              ActiveCell.BorderAround ColorIndex:=45, Weight:=xlMedium

            With Selection.Interior
                .Pattern = xlLightUp
                .PatternColor = 26367
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With


          End If
          
          'Eintrag der Stunden ins Konto krank nach Hause
'          If wert1_17 > 10 Then
                Cells(345, ActiveCell.Column) = Cells(345, ActiveCell.Column) + wert2_17
                
'          ElseIf wert1_17 > 0 Then
'                Cells(490, ActiveCell.Column) = Cells(490, ActiveCell.Column) + wert2_17
'
'          Else
'                Cells(510, ActiveCell.Column) = Cells(510, ActiveCell.Column) + wert2_17
'          End If
  End If
  
  
  'Fähigkeitenwerkstatt
  
  If akennz = 18 Then
          Dim wert1_18 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_18 As Double
          
          wert1_18 = ActiveCell.Value
          wert2_18 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
        'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_18 & " Stunde(n) Fähigkeitenwerkstatt " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_18 & " Stunde(n) Fähigkeitenwerkstatt " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_18 < 0 Then
              ActiveCell.Value = wert1_18 + wert2_18
          Else
              ActiveCell.Value = wert1_18 - wert2_18
          End If
          
          'Eintrag der Stunden ins Konto Fähigkeitenwerkstatt
'          If wert1_18 > 10 Then
                Cells(346, ActiveCell.Column) = Cells(346, ActiveCell.Column) + wert2_18

'          ElseIf wert1_18 > 0 Then
'                Cells(492, ActiveCell.Column) = Cells(492, ActiveCell.Column) + wert2_18
'
'          Else
'                Cells(512, ActiveCell.Column) = Cells(512, ActiveCell.Column) + wert2_18
'          End If
  End If
  
  'Mini-CttC
  
'  If akennz = 19 Then
'          Dim wert1_19 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
'          Dim wert2_19 As Double
'
'          wert1_19 = ActiveCell.Value
'          wert2_19 = UserForm2.TextBox2.Value
'          Kommentartext = UserForm2.TextBox3.Value
'
'          'Kommentar hinzufügen
'          If ActiveCell.Comment Is Nothing Then
'                With ActiveCell.AddComment
'                    .Shape.TextFrame.AutoSize = True
'                    .Text wert2_19 & " Stunde(n) Mini-CttC" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
'                End With
'          Else
'            vorhandener_Kommentar = ActiveCell.Comment.Text
'            ActiveCell.Comment.Delete
'                With ActiveCell.AddComment
'                    .Text vorhandener_Kommentar & wert2_19 & " Stunde(n) Mini-CttC" & Chr(10) & _
 Chr(10) & Kommentartext & Chr(10) & Chr(10)
'                    .Shape.TextFrame.AutoSize = True
'                End With
'        End If
'
'          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
'          If wert1_19 < 0 Then
'              ActiveCell.Value = wert1_19 + wert2_19
'          Else
'              ActiveCell.Value = wert1_19 - wert2_19
'          End If
'
'          'Eintrag der Stunden ins Konto Mini-CttC
'          If wert1_19 > 10 Then
'                Cells(531, ActiveCell.Column) = Cells(531, ActiveCell.Column) + wert2_19
'
'          ElseIf wert1_19 > 0 Then
'                Cells(491, ActiveCell.Column) = Cells(491, ActiveCell.Column) + wert2_19
'
'          Else
'                Cells(511, ActiveCell.Column) = Cells(511, ActiveCell.Column) + wert2_19
'          End If
'  End If
  
'     'Info Kommentar
'
'  If akennz = 29 Then
'          Dim wert1_29 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
'          Dim wert2_29 As Double
'
'          wert1_29 = ActiveCell.Value
'          wert2_29 = UserForm2.TextBox2.Value
'          Kommentartext = UserForm2.TextBox3.Value
'
'        'Kommentar hinzufügen
'        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
'                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & "  _
- " & Application.UserName & ": " & wert2_29 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
'
'          Else
'            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
'            Cells(AktZeile + 1, AktSpalte).Value = ""
'                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_29 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
'
'        End If
'
'          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
'          If wert1_29 < 0 Then
'              ActiveCell.Value = wert1_29 + wert2_29
'          Else
'              ActiveCell.Value = wert1_29 - wert2_29
'          End If
'
'          'Eintrag der Stunden ins Konto Besprechung
'
'                Cells(332, ActiveCell.Column) = Cells(332, ActiveCell.Column) + wert2_29
''
'
'  End If
  
  'Profit
  
  If akennz = 20 Then
          Dim wert1_20 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_20 As Double
          
          wert1_20 = ActiveCell.Value
          wert2_20 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
        'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_20 & " Stunde(n) Profit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_20 & " Stunde(n) Profit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If wert1_20 < 0 Then
              ActiveCell.Value = wert1_20 + wert2_20
          Else
              ActiveCell.Value = wert1_20 - wert2_20
          End If
          
          'Eintrag der Stunden ins Konto Profit
'          If wert1_20 > 10 Then
                Cells(347, ActiveCell.Column) = Cells(347, ActiveCell.Column) + wert2_20
                
'          ElseIf wert1_20 > 0 Then
'                Cells(493, ActiveCell.Column) = Cells(493, ActiveCell.Column) + wert2_20
'
'          Else
'                Cells(513, ActiveCell.Column) = Cells(513, ActiveCell.Column) + wert2_20
'          End If
  End If

'=============================================================================================== _
============


  'Freiwillige Mehrarbeit nach Schicht

  If akennz = 21 Then
          Dim wert1_21 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_21 As Double

          wert1_21 = ActiveCell.Value
          wert2_21 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value

                'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_21 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_21 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If



          'Eintrag der Stunden in Zusatzpower
       Dim number As Integer
number = ActiveCell
        
Select Case number

    Case 10 To 20


               Cells(442, ActiveCell.Column) = Cells(442, ActiveCell.Column) + wert2_21

            If Cells(442, ActiveCell.Column).Comment Is Nothing Then
                With Cells(442, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(442, ActiveCell.Column).Comment.Text
                Cells(442, ActiveCell.Column).Comment.Delete
                With Cells(442, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 110 To 120


                Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) - wert2_21
            If Cells(441, ActiveCell.Column).Comment Is Nothing Then
                With Cells(441, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
                Cells(441, ActiveCell.Column).Comment.Delete
                With Cells(441, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -20 To -10

                Cells(443, ActiveCell.Column + 1) = Cells(443, ActiveCell.Column + 1) +  _
wert2_21

            If Cells(443, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(443, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(443, ActiveCell.Column + 1).Comment.Text
                Cells(443, ActiveCell.Column + 1).Comment.Delete
                With Cells(443, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If


    Case 30 To 40


               Cells(445, ActiveCell.Column) = Cells(445, ActiveCell.Column) + wert2_21

            If Cells(445, ActiveCell.Column).Comment Is Nothing Then
                With Cells(445, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(445, ActiveCell.Column).Comment.Text
                Cells(445, ActiveCell.Column).Comment.Delete
                With Cells(445, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 130 To 140


                Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) - wert2_21
                
            If Cells(444, ActiveCell.Column).Comment Is Nothing Then
                With Cells(444, ActiveCell.Column).AddComment
                 .Shape.TextFrame.AutoSize = True
                 .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
 Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
                Cells(444, ActiveCell.Column).Comment.Delete
                With Cells(444, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -40 To -30

                Cells(446, ActiveCell.Column + 1) = Cells(446, ActiveCell.Column + 1) +  _
wert2_21

            If Cells(446, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(446, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(446, ActiveCell.Column + 1).Comment.Text
                Cells(446, ActiveCell.Column + 1).Comment.Delete
                With Cells(446, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If

    Case 50 To 60


               Cells(448, ActiveCell.Column) = Cells(448, ActiveCell.Column) + wert2_21

            If Cells(448, ActiveCell.Column).Comment Is Nothing Then
                With Cells(448, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(448, ActiveCell.Column).Comment.Text
                Cells(448, ActiveCell.Column).Comment.Delete
                With Cells(448, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 150 To 160


                Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) - wert2_21
                
            If Cells(447, ActiveCell.Column).Comment Is Nothing Then
                With Cells(447, ActiveCell.Column).AddComment
                 .Shape.TextFrame.AutoSize = True
                 .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
 Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
                Cells(447, ActiveCell.Column).Comment.Delete
                With Cells(447, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -60 To -50

                Cells(449, ActiveCell.Column + 1) = Cells(449, ActiveCell.Column + 1) +  _
wert2_21

            If Cells(449, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(449, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(449, ActiveCell.Column + 1).Comment.Text
                Cells(449, ActiveCell.Column + 1).Comment.Delete
                With Cells(449, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If


End Select

  End If


  'Freiwillige Mehrarbeit vor Schicht

  If akennz = 22 Then
          Dim wert1_22 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_22 As Double

          wert1_22 = ActiveCell.Value
          wert2_22 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value

                'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_22 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_22 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If

'Eintrag der Stunden in Zusatzpower

        Dim numbere As Integer
numbere = ActiveCell
        
    Select Case numbere

        Case 10 To 20
                        Cells(443, ActiveCell.Column) = Cells(443, ActiveCell.Column) +  _
wert2_22
                    
                                If Cells(443, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(443, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(443, ActiveCell.Column).Comment. _
Text
                                Cells(443, ActiveCell.Column).Comment.Delete
                                    With Cells(443, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 110 To 120
                                
                        Cells(442, ActiveCell.Column - 1) = Cells(442, ActiveCell.Column - 1) -  _
wert2_22
        
                            If Cells(442, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(442, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(442, ActiveCell.Column - 1).Comment. _
Text
                        Cells(442, ActiveCell.Column - 1).Comment.Delete
                                With Cells(442, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -20 To -10


                      Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) + wert2_22
            
                            If Cells(441, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(441, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
                        Cells(441, ActiveCell.Column).Comment.Delete
                            With Cells(441, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If


        Case 30 To 40
                        Cells(446, ActiveCell.Column) = Cells(446, ActiveCell.Column) +  _
wert2_22
                    
                                If Cells(446, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(446, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(446, ActiveCell.Column).Comment. _
Text
                                Cells(446, ActiveCell.Column).Comment.Delete
                                    With Cells(446, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 130 To 140
                                
                        Cells(445, ActiveCell.Column - 1) = Cells(445, ActiveCell.Column - 1) -  _
wert2_22
        
                            If Cells(445, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(445, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(445, ActiveCell.Column - 1).Comment. _
Text
                        Cells(445, ActiveCell.Column - 1).Comment.Delete
                                With Cells(445, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -40 To -30


                      Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) + wert2_22
            
                            If Cells(444, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(444, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
                        Cells(444, ActiveCell.Column).Comment.Delete
                            With Cells(444, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If


        Case 50 To 60
                        Cells(449, ActiveCell.Column) = Cells(449, ActiveCell.Column) +  _
wert2_22
                    
                                If Cells(449, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(449, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(449, ActiveCell.Column).Comment. _
Text
                                Cells(449, ActiveCell.Column).Comment.Delete
                                    With Cells(449, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 150 To 160
                                
                        Cells(448, ActiveCell.Column - 1) = Cells(448, ActiveCell.Column - 1) -  _
wert2_22
        
                            If Cells(448, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(448, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(448, ActiveCell.Column - 1).Comment. _
Text
                        Cells(448, ActiveCell.Column - 1).Comment.Delete
                                With Cells(448, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -20 To -10


                      Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) + wert2_22
            
                            If Cells(447, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(447, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
                        Cells(447, ActiveCell.Column).Comment.Delete
                            With Cells(447, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If
                      
            End Select
   
   
  End If
  

  
    '=========================================================================================== _
=================================================================
   

 'Kalenderliste Mehrarbeit nach Schicht

  If akennz = 23 Then
          Dim wert1_23 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_23 As Double

          wert1_23 = ActiveCell.Value
          wert2_23 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value

                'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_23 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_23 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If


          'Eintrag der Stunden in Zusatzpower
       Dim number1 As Integer
number1 = ActiveCell
        
Select Case number1

    Case 10 To 20


               Cells(442, ActiveCell.Column) = Cells(442, ActiveCell.Column) + wert2_23

            If Cells(442, ActiveCell.Column).Comment Is Nothing Then
                With Cells(442, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(442, ActiveCell.Column).Comment.Text
                Cells(442, ActiveCell.Column).Comment.Delete
                With Cells(442, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 110 To 120


                Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) - wert2_23
            If Cells(441, ActiveCell.Column).Comment Is Nothing Then
                With Cells(441, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
                Cells(441, ActiveCell.Column).Comment.Delete
                With Cells(441, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -20 To -10

                Cells(443, ActiveCell.Column + 1) = Cells(443, ActiveCell.Column + 1) +  _
wert2_23

            If Cells(443, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(443, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(443, ActiveCell.Column + 1).Comment.Text
                Cells(443, ActiveCell.Column + 1).Comment.Delete
                With Cells(443, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If


    Case 30 To 40


               Cells(445, ActiveCell.Column) = Cells(445, ActiveCell.Column) + wert2_23

            If Cells(445, ActiveCell.Column).Comment Is Nothing Then
                With Cells(445, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(445, ActiveCell.Column).Comment.Text
                Cells(445, ActiveCell.Column).Comment.Delete
                With Cells(445, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 130 To 140


                Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) - wert2_23
                
            If Cells(444, ActiveCell.Column).Comment Is Nothing Then
                With Cells(444, ActiveCell.Column).AddComment
                 .Shape.TextFrame.AutoSize = True
                 .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
 Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
                Cells(444, ActiveCell.Column).Comment.Delete
                With Cells(444, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -40 To -30

                Cells(446, ActiveCell.Column + 1) = Cells(446, ActiveCell.Column + 1) +  _
wert2_23

            If Cells(446, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(446, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(446, ActiveCell.Column + 1).Comment.Text
                Cells(446, ActiveCell.Column + 1).Comment.Delete
                With Cells(446, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If

    Case 50 To 60


               Cells(448, ActiveCell.Column) = Cells(448, ActiveCell.Column) + wert2_23

            If Cells(448, ActiveCell.Column).Comment Is Nothing Then
                With Cells(448, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(448, ActiveCell.Column).Comment.Text
                Cells(448, ActiveCell.Column).Comment.Delete
                With Cells(448, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 150 To 160


                Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) - wert2_23
                
            If Cells(447, ActiveCell.Column).Comment Is Nothing Then
                With Cells(447, ActiveCell.Column).AddComment
                 .Shape.TextFrame.AutoSize = True
                 .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
 Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
                Cells(447, ActiveCell.Column).Comment.Delete
                With Cells(447, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -60 To -50

                Cells(449, ActiveCell.Column + 1) = Cells(449, ActiveCell.Column + 1) +  _
wert2_23

            If Cells(449, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(449, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(449, ActiveCell.Column + 1).Comment.Text
                Cells(449, ActiveCell.Column + 1).Comment.Delete
                With Cells(449, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If


End Select

  End If


  'Kalenderliste Mehrarbeit vor Schicht

  If akennz = 24 Then
          Dim wert1_24 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_24 As Double

          wert1_24 = ActiveCell.Value
          wert2_24 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value

                'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_24 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_24 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If

'Eintrag der Stunden in Zusatzpower

        Dim numbere1 As Integer
numbere1 = ActiveCell
        
    Select Case numbere1

        Case 10 To 20
                        Cells(443, ActiveCell.Column) = Cells(443, ActiveCell.Column) +  _
wert2_24
                    
                                If Cells(443, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(443, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(443, ActiveCell.Column).Comment. _
Text
                                Cells(443, ActiveCell.Column).Comment.Delete
                                    With Cells(443, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 110 To 120
                                
                        Cells(442, ActiveCell.Column - 1) = Cells(442, ActiveCell.Column - 1) -  _
wert2_24
        
                            If Cells(442, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(442, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(442, ActiveCell.Column - 1).Comment. _
Text
                        Cells(442, ActiveCell.Column - 1).Comment.Delete
                                With Cells(442, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -20 To -10


                      Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) + wert2_24
            
                            If Cells(441, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(441, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
                        Cells(441, ActiveCell.Column).Comment.Delete
                            With Cells(441, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If


        Case 30 To 40
                        Cells(446, ActiveCell.Column) = Cells(446, ActiveCell.Column) +  _
wert2_24
                    
                                If Cells(446, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(446, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(446, ActiveCell.Column).Comment. _
Text
                                Cells(446, ActiveCell.Column).Comment.Delete
                                    With Cells(446, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 130 To 140
                                
                        Cells(445, ActiveCell.Column - 1) = Cells(445, ActiveCell.Column - 1) -  _
wert2_24
        
                            If Cells(445, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(445, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(445, ActiveCell.Column - 1).Comment. _
Text
                        Cells(445, ActiveCell.Column - 1).Comment.Delete
                                With Cells(445, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -40 To -30


                      Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) + wert2_24
            
                            If Cells(444, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(444, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
                        Cells(444, ActiveCell.Column).Comment.Delete
                            With Cells(444, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If


        Case 50 To 60
                        Cells(449, ActiveCell.Column) = Cells(449, ActiveCell.Column) +  _
wert2_24
                    
                                If Cells(449, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(449, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(449, ActiveCell.Column).Comment. _
Text
                                Cells(449, ActiveCell.Column).Comment.Delete
                                    With Cells(449, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 150 To 160
                                
                        Cells(448, ActiveCell.Column - 1) = Cells(448, ActiveCell.Column - 1) -  _
wert2_24
        
                            If Cells(448, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(448, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(448, ActiveCell.Column - 1).Comment. _
Text
                        Cells(448, ActiveCell.Column - 1).Comment.Delete
                                With Cells(448, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -20 To -10


                      Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) + wert2_24
            
                            If Cells(447, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(447, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
                        Cells(447, ActiveCell.Column).Comment.Delete
                            With Cells(447, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If
                      
            End Select
   
   
  End If
  

  
 
  'Kalenderliste Mehrarbeit TZ
  
  If akennz = 25 Then
          Dim wert1_25 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_25 As Double
'          Dim schließen As Boolean
          
          wert1_25 = ActiveCell.Value
          wert2_25 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
          'Abfrage ob MA TZ ist
          If AktZeile >= 20 And AktZeile <= 140 Then
          MsgBox ("Fehler - TZ MA auswählen")
          schließen = True
          Else
          schließen = False

          End If
                 'Kommentar hinzufügen
        If schließen = True Then
                 
        ElseIf ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_25 & " Stunde(n) Kal-Mehrarbeit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_25 & " Stunde(n) Kal-Mehrarbeit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If schließen = True Then
          
          ElseIf wert1_25 < 0 Then
              ActiveCell.Value = wert1_25 - wert2_25
          Else
              ActiveCell.Value = wert1_25 + wert2_25
          End If
          
   End If

 '============================================================================================== _
===========================================================

   'Angeordnete Mehrarbeit nach Schicht

  If akennz = 26 Then
          Dim wert1_26 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_26 As Double

          wert1_26 = ActiveCell.Value
          wert2_26 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value

                'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_26 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_26 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If



          'Eintrag der Stunden in Zusatzpower
       Dim number2 As Integer
number2 = ActiveCell
        
Select Case number2

    Case 10 To 20


               Cells(442, ActiveCell.Column) = Cells(442, ActiveCell.Column) + wert2_26

            If Cells(442, ActiveCell.Column).Comment Is Nothing Then
                With Cells(442, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(442, ActiveCell.Column).Comment.Text
                Cells(442, ActiveCell.Column).Comment.Delete
                With Cells(442, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 110 To 120


                Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) - wert2_26
            If Cells(441, ActiveCell.Column).Comment Is Nothing Then
                With Cells(441, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
                Cells(441, ActiveCell.Column).Comment.Delete
                With Cells(441, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -20 To -10

                Cells(443, ActiveCell.Column + 1) = Cells(443, ActiveCell.Column + 1) +  _
wert2_26

            If Cells(443, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(443, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(443, ActiveCell.Column + 1).Comment.Text
                Cells(443, ActiveCell.Column + 1).Comment.Delete
                With Cells(443, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If


    Case 30 To 40


               Cells(445, ActiveCell.Column) = Cells(445, ActiveCell.Column) + wert2_26

            If Cells(445, ActiveCell.Column).Comment Is Nothing Then
                With Cells(445, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(445, ActiveCell.Column).Comment.Text
                Cells(445, ActiveCell.Column).Comment.Delete
                With Cells(445, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 130 To 140


                Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) - wert2_26
                
            If Cells(444, ActiveCell.Column).Comment Is Nothing Then
                With Cells(444, ActiveCell.Column).AddComment
                 .Shape.TextFrame.AutoSize = True
                 .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
 Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
                Cells(444, ActiveCell.Column).Comment.Delete
                With Cells(444, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -40 To -30

                Cells(446, ActiveCell.Column + 1) = Cells(446, ActiveCell.Column + 1) +  _
wert2_26

            If Cells(446, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(446, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(446, ActiveCell.Column + 1).Comment.Text
                Cells(446, ActiveCell.Column + 1).Comment.Delete
                With Cells(446, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If

    Case 50 To 60


               Cells(448, ActiveCell.Column) = Cells(448, ActiveCell.Column) + wert2_26

            If Cells(448, ActiveCell.Column).Comment Is Nothing Then
                With Cells(448, ActiveCell.Column).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(448, ActiveCell.Column).Comment.Text
                Cells(448, ActiveCell.Column).Comment.Delete
                With Cells(448, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
                
    Case 150 To 160


                Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) - wert2_26
                
            If Cells(447, ActiveCell.Column).Comment Is Nothing Then
                With Cells(447, ActiveCell.Column).AddComment
                 .Shape.TextFrame.AutoSize = True
                 .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
 Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
                Cells(447, ActiveCell.Column).Comment.Delete
                With Cells(447, ActiveCell.Column).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If
    


    Case -60 To -50

                Cells(449, ActiveCell.Column + 1) = Cells(449, ActiveCell.Column + 1) +  _
wert2_26

            If Cells(449, ActiveCell.Column + 1).Comment Is Nothing Then
                With Cells(449, ActiveCell.Column + 1).AddComment
                    .Shape.TextFrame.AutoSize = True
                    .Text wert2_26 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                End With
                Else
                vorhandener_Kommentar = Cells(449, ActiveCell.Column + 1).Comment.Text
                Cells(449, ActiveCell.Column + 1).Comment.Delete
                With Cells(449, ActiveCell.Column + 1).AddComment
                    .Text vorhandener_Kommentar & wert2_26 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
                    .Shape.TextFrame.AutoSize = True
                End With
            End If


End Select

  End If


  'Angeordnete Mehrarbeit vor Schicht

  If akennz = 27 Then
          Dim wert1_27 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_27 As Double

          wert1_27 = ActiveCell.Value
          wert2_27 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value

                'Kommentar hinzufügen
        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_27 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_27 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If

'Eintrag der Stunden in Zusatzpower

        Dim numbere2 As Integer
numbere2 = ActiveCell
        
    Select Case numbere2

        Case 10 To 20
                        Cells(443, ActiveCell.Column) = Cells(443, ActiveCell.Column) +  _
wert2_27
                    
                                If Cells(443, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(443, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(443, ActiveCell.Column).Comment. _
Text
                                Cells(443, ActiveCell.Column).Comment.Delete
                                    With Cells(443, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 110 To 120
                                
                        Cells(442, ActiveCell.Column - 1) = Cells(442, ActiveCell.Column - 1) -  _
wert2_27
        
                            If Cells(442, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(442, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(442, ActiveCell.Column - 1).Comment. _
Text
                        Cells(442, ActiveCell.Column - 1).Comment.Delete
                                With Cells(442, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -20 To -10


                      Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) + wert2_27
            
                            If Cells(441, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(441, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
                        Cells(441, ActiveCell.Column).Comment.Delete
                            With Cells(441, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If


        Case 30 To 40
                        Cells(446, ActiveCell.Column) = Cells(446, ActiveCell.Column) +  _
wert2_27
                    
                                If Cells(446, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(446, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(446, ActiveCell.Column).Comment. _
Text
                                Cells(446, ActiveCell.Column).Comment.Delete
                                    With Cells(446, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 130 To 140
                                
                        Cells(445, ActiveCell.Column - 1) = Cells(445, ActiveCell.Column - 1) -  _
wert2_27
        
                            If Cells(445, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(445, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(445, ActiveCell.Column - 1).Comment. _
Text
                        Cells(445, ActiveCell.Column - 1).Comment.Delete
                                With Cells(445, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -40 To -30


                      Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) + wert2_27
            
                            If Cells(444, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(444, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
                        Cells(444, ActiveCell.Column).Comment.Delete
                            With Cells(444, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If


        Case 50 To 60
                        Cells(449, ActiveCell.Column) = Cells(449, ActiveCell.Column) +  _
wert2_27
                    
                                If Cells(449, ActiveCell.Column).Comment Is Nothing Then
                                With Cells(449, ActiveCell.Column).AddComment
                                        .Shape.TextFrame.AutoSize = True
                                        .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    End With
                            Else
                                  vorhandener_Kommentar = Cells(449, ActiveCell.Column).Comment. _
Text
                                Cells(449, ActiveCell.Column).Comment.Delete
                                    With Cells(449, ActiveCell.Column).AddComment
                                        .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                        .Shape.TextFrame.AutoSize = True
                                    End With
                                End If

         Case 150 To 160
                                
                        Cells(448, ActiveCell.Column - 1) = Cells(448, ActiveCell.Column - 1) -  _
wert2_27
        
                            If Cells(448, ActiveCell.Column - 1).Comment Is Nothing Then
                            With Cells(448, ActiveCell.Column - 1).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                        Else
                            vorhandener_Kommentar = Cells(448, ActiveCell.Column - 1).Comment. _
Text
                        Cells(448, ActiveCell.Column - 1).Comment.Delete
                                With Cells(448, ActiveCell.Column - 1).AddComment
                                    .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                    .Shape.TextFrame.AutoSize = True
                                End With
                        End If
                                
                                
        Case -20 To -10


                      Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) + wert2_27
            
                            If Cells(447, ActiveCell.Column).Comment Is Nothing Then
                            With Cells(447, ActiveCell.Column).AddComment
                                .Shape.TextFrame.AutoSize = True
                                .Text wert2_27 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
                            End With
                      Else
                        vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
                        Cells(447, ActiveCell.Column).Comment.Delete
                            With Cells(447, ActiveCell.Column).AddComment
                                .Text vorhandener_Kommentar & wert2_27 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
                                .Shape.TextFrame.AutoSize = True
                            End With
                      End If
                      
            End Select
   
   
  End If
  

  
  

 
  
  'Angeordnete Mehrarbeit TZ
  
  If akennz = 28 Then
          Dim wert1_28 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
          Dim wert2_28 As Double
'          Dim schließen As Boolean
          
          wert1_28 = ActiveCell.Value
          wert2_28 = UserForm2.TextBox2.Value
          Kommentartext = UserForm2.TextBox3.Value
          
          'Abfrage ob MA TZ ist
          If AktZeile >= 20 And AktZeile <= 140 Then
          MsgBox ("Fehler - TZ MA auswählen")
          schließen = True
          Else
          schließen = False

          End If
                 'Kommentar hinzufügen
        If schließen = True Then
                 
        ElseIf ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
 " & Application.UserName & ": " & wert2_28 & " Stunde(n) Ang-Mehrarbeit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

          Else
            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
            Cells(AktZeile + 1, AktSpalte).Value = ""
                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_28 & " Stunde(n) Ang-Mehrarbeit " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "

        End If
          
          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
          If schließen = True Then
          
          ElseIf wert1_28 < 0 Then
              ActiveCell.Value = wert1_28 - wert2_28
          Else
              ActiveCell.Value = wert1_28 + wert2_28
          End If
          
   End If
  
  'UserForm2 nach "OK" schließen
    Unload UserForm2
  
  
  Exit Sub
FehlerFall:
  MsgBox "Es ist ein Fehler bei Mitarbeiter " & Mitarbeiter & " aufgetreten!"
  
End Sub


Private Sub CommandButton2_Click()
 Unload UserForm2
End Sub



Ich Hoffe ihr könnt mir irgendwie weiter helfen?

Vielen Dank im Vorraus und Viele Grüße,

Nicolai S.

  

Betrifft: AW: VBA-Prozedur zu groß von: Daniel
Geschrieben am: 08.10.2014 12:31:59

Hi
naja, das ist mir jetzt zu viel, um mich da ohne Aufwandsentschädiungs durcharbeiten.
aber einen Tip zur Verkürzung kann ich dir geben:

wenn du statt der Optionbuttons 1-29 eine List- oder Combobox einsetzt, dann verkürzt sich dieser Codeteil:

 If d2.OptionButton1.Value = True Then
 akennz = 1 'Arbeitsvorbereitung
 ElseIf d2.OptionButton2.Value = True Then
 akennz = 2 'Besprechung
 ElseIf d2.OptionButton3.Value = True Then
 akennz = 3 'Einarbeitung
 ElseIf d2.OptionButton4.Value = True Then
 akennz = 4 'Schulung
 ElseIf d2.OptionButton5.Value = True Then
 akennz = 5 'KVP
 ElseIf d2.OptionButton6.Value = True Then
 akennz = 6 'Erste Hilfe
 ElseIf d2.OptionButton7.Value = True Then
 akennz = 7 'EBA
 ElseIf d2.OptionButton8.Value = True Then
 akennz = 8 'QS
 ElseIf d2.OptionButton9.Value = True Then
 akennz = 9 'BR
 ElseIf d2.OptionButton10.Value = True Then
 akennz = 10 'Anlagenausfall
 ElseIf d2.OptionButton11.Value = True Then
 akennz = 11 'Springer
 ElseIf d2.OptionButton12.Value = True Then
 akennz = 12 'Sonstiges
 ElseIf d2.OptionButton13.Value = True Then
 akennz = 13 'ZE
 ElseIf d2.OptionButton14.Value = True Then
 akennz = 14 'Ebenenwechsel
 ElseIf d2.OptionButton15.Value = True Then
 akennz = 15 'Zusatzpower
 ElseIf d2.OptionButton16.Value = True Then
 akennz = 16 'FreiW Mehrarbeit TZ
 ElseIf d2.OptionButton17.Value = True Then
 akennz = 17 'krank nach Hause
 ElseIf d2.OptionButton18.Value = True Then
 akennz = 18 'Fähigkeitenwerkstatt
' If d2.OptionButton19.Value = True Then akennz = 19 'Mini-CttC
 ElseIf d2.OptionButton20.Value = True Then
 akennz = 20 'ProFit
 ElseIf d2.OptionButton21.Value = True Then
 akennz = 21 'FreiW Mehrarbeit nach Schicht
 ElseIf d2.OptionButton22.Value = True Then
 akennz = 22 'FreiW Mehrarbeit vor Schicht
  ElseIf d2.OptionButton23.Value = True Then
 akennz = 23 'Kal.Mehrarbeit nach Schicht
   ElseIf d2.OptionButton24.Value = True Then
 akennz = 24 'Kal.Mehrarbeit vor Schicht
   ElseIf d2.OptionButton25.Value = True Then
 akennz = 25 'KalMehrarbeit TZ
   ElseIf d2.OptionButton26.Value = True Then
 akennz = 26 'Ang. Mehrarbeit nach Schicht
   ElseIf d2.OptionButton27.Value = True Then
 akennz = 27 'Ang. Mehrarbeit vor Schicht
   ElseIf d2.OptionButton28.Value = True Then
 akennz = 28 'Ang.Mehrarbeit TZ
    ElseIf d2.OptionButton29.Value = True Then
     akennz = 29 'Info Kommentar
 Else
 MsgBox ("Bitte Grund für Eintragung auswählen")
 Exit Sub
 End If
zu:
If Combobox1.ListIndex = -1 Then
    MsgBox ("Bitte Grund für Eintragung auswählen")
    Exit Sub
Else
    akennz = Combobox1.ListIndex + 1
end If
Gruß Daniel


  

Betrifft: AW: VBA-Prozedur zu groß von: Nicolai
Geschrieben am: 08.10.2014 13:08:55

Selbst wenn ich dieses Abschnitt kürze, wäre es immer noch zu lang.

Gibt es nicht eine möglichkeit mit "Call Prozdeur" das er den Code trotzdem ausführt?

Vielen Dank & Grüße,

Nicolai


  

Betrifft: AW: VBA-Prozedur zu groß von: Daniel
Geschrieben am: 08.10.2014 13:47:23

Hi
weiterhin ist es unsinn, dass du für jeden Fall eigene Variablen anlegst und dann den kompletten Code wiederholst.

du brauchst kein wert1_1, wert1_2, wert1_3, ..., wert1_29

der Anwender kann ja immer nur eine Option auswählen, deswegen reicht ein wert1
im Code sind dann ja viele Befehle für alle Optionen gleich, diese kannst du dann bei allen Fällen ausführen, dann musst du sie auch nur 1x hinschreiben und nicht 29x wiederholen.
Eine Fallunterscheidung machst du dann nur für die Fälle, die sich unterscheiden.

momentan ist dies deine Programmstruktur:

FAllUNTERSCHEIDUNG
    Fall 1
       Code der bei allen Fällen ausgeführt werden muss
       Code Fall 1 - Spezifisch
       Code der bei allen Fällen ausgeführt werden muss
    Fall 2
       Code der bei allen Fällen ausgeführt werden muss
       Code Fall 2 - Spezifisch
       Code der bei allen Fällen ausgeführt werden muss
    Fall 3
       Code der bei allen Fällen ausgeführt werden muss
       Code Fall 3 - Spezifisch
       Code der bei allen Fällen ausgeführt werden muss
ENDE FALLUNTERSCHEIDUNG
du solltest jedoch folgende Struktur anstreben:
Code der bei allen Fällen ausgeführt werden muss
FALLUNTERSCHEIDUNG
   Fall 1
      Fall 1 - spezifischer Code
   Fall 2
      Fall 2 - spezifischer Code
   Fall 3
      Fall 3 - spezifischer Code
ENDE FALLUNTERSCHEIDUNG
Code der in allen Fällen ausgeführt werden muss
Gruß Daniel


  

Betrifft: AW: VBA-Prozedur zu groß von: Michael
Geschrieben am: 08.10.2014 13:56:31

Hallo Nicolai,

zunächst möchte ich mich Daniel anschließen: zu viel Arbeit für lau.

Wenn Daniels Vorschlag nicht zur Lösung Deines Problems führt, erhebt sich die Frage, was Du denn zwischen dem letzten funktionsfähigen Stand und dem jetzigen, wo es nicht mehr geht, gemacht hast.

Um Dich zu zitieren:
"ich habe gerade mein Marko erweitert und dann kamm die Fehlermeldung das die Prozedur zu groß ist."

Grundsätzlich hat eine prozedurale Sprache wie VBA je den Vorteil, daß man einzelne Sachen in S*U*Bs verpacken kann. Du kannst also "einfache Teile" auslagern und aufrufen, damit die Prozedur kleiner wird, oder Du kannst "ähnlich wiederkehrende Teile" auslagern und mit entsprechenden Variablen aufrufen.

Ich hab mir mal die Teile ab
If akennz = 2 Then
und
If akennz = 3 Then
nebeneinander in eine Tabelle (ab A1 bzw. J1) kopiert, um Unterschiede zu sehen: beide Dinger machen exakt das Gleiche, bis auf:
Zeile 13 und 19: "Besprechung" bzw. "Einarbeitung"
Zeile 32, 35 und 37: unterschiedliche Zeilennummern, in die die Werte geschrieben werden.

Wenn Du das in eine Prozedur auslagerst, brauchst Du nur den geänderten Text bzw. die Zellen bzw. Nummern beim Aufruf mit zu übergeben, und schon verkürzt sich alles, etwa so:

If akennz = 2 Then Werte_Schreiben("Besprechung",332,476,496)
If akennz = 3 Then Werte_Schreiben("Einarbeitung",332,477,497)

Und das noch: Deine Prozedur wird von oben bis unten durchlaufen, und Du deklarierst wild Variablen, die exakt das gleiche tun, x-fach...
Dim wert1_2 As Double
... ohne sie hinterher noch einmal zu verwenden. Einmal am Anfang reicht völlig.

Bis dahin umsonst.

Schöne Grüße,

Michael


  

Betrifft: Nachtrag von: Michael
Geschrieben am: 08.10.2014 14:02:43

Das noch: habe die zwei Werte vergessen. Ein Prozeduraufruf könnte dann also heißen:

If akennz = 2 Then Werte_Schreiben("Besprechung",332,476,496,wert1,wert2)

oder, weil extra Variablen eigentlich unnötig sind:

If akennz = 2 Then Werte_Schreiben("Besprechung",332,476,496, _
ActiveCell.Value,UserForm2.TextBox2.Value)