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 Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Case Anwendung beim eintragen | Herbers Excel-Forum


Betrifft: Case Anwendung beim eintragen von: Heinz H.
Geschrieben am: 31.12.2011 18:39:35

Hallo Leute
Ich habe eine UserForm mit ComboBoxen.
Nun möchte ich zB. den Wert von "ComboBoxSortierer1" in den Sheets "Personalbesetzung" eintragen lassen.
Nun kommt aber immer die Fehlermeldung

Für die Auswahl "Wert von ComboBoxSortierer1" Fehlt noch eine Case-Zeile im Makro.

Könnte mir dazu bitte jemand weiterhelfen?

Gruß
Heinz

  

Betrifft: warum schreibst Du die Zeile dann nicht rein? von: Matthias L
Geschrieben am: 31.12.2011 18:49:47

Hallo Heinz

Zitat:
Für die Auswahl "Wert von ComboBoxSortierer1" Fehlt noch eine Case-Zeile im Makro.

Wenn Du das nun schon weiß, warum schreibst Du diese Zeile dann nicht rein?
Welche Antwort würdest Du denn geben können wenn Du Deine Frage mal selbst liest ;-)

Gruß Matthias


  

Betrifft: AW: warum schreibst Du die Zeile dann nicht rein? von: Heinz H.
Geschrieben am: 31.12.2011 19:12:54

Hallo Matthias

warum schreibst Du diese Zeile dann nicht rein?
Wenn ich wüsste wie? Oder könntest du mir ein Beispiel geben?
Danke
Heinz


  

Betrifft: AW: Case Anwendung beim eintragen von: Hajo_Zi
Geschrieben am: 31.12.2011 19:38:22

Hallo Heinz,

nur wenige sehen Deinen Code.

GrußformelHomepage


  

Betrifft: AW: Case Anwendung beim eintragen von: Heinz H.
Geschrieben am: 31.12.2011 19:45:55

Hallo Hajo

Der Code ist elends lang.
Aber ich probiere es einmal.
Wünsche ein Prosit Neujahr.
Gruß
Heinz

Private Sub CB_Aus_Click()
Application.ScreenUpdating = False
MyLabel = ""
MA_Fehl.Visible = False
ListFehl.Clear
ListFehl.Visible = False
Application.ScreenUpdating = True
End Sub

Private Sub CB_Ein_Click()
'Makro starten und Fehlende Mitarbeiter auflisten
Dim SuchSpalte As Long, i As Long, k As Long, u As Long, MyChk As Long
Dim ChkStr As Variant, MyArr(1)
Dim ci As Long

Application.EnableEvents = False
Application.ScreenUpdating = False
k = 0
u = 0
MyChk = 0
UserForm2.ListFehl.Clear

SuchSpalte = ComboBoxDatum.ListIndex + 3  'listindex startet mit 0!!
For i = 3 To 154
   ChkStr = Trim(Cells(i, SuchSpalte).Value)
   If UCase(Cells(i, SuchSpalte).Value) = "K" Then
      
      UserForm2.ListFehl.AddItem Cells(i, 1).Value & "      Krank"
      k = k + 1
   End If
Next i
For i = 3 To 154
   ChkStr = Trim(Cells(i, SuchSpalte).Value)
   If UCase(Cells(i, SuchSpalte).Value) = "U" Then
      UserForm2.ListFehl.AddItem Cells(i, 1).Value & "      Urlaub"
      u = u + 1
   End If
Next i
For i = 3 To 154
   ChkStr = Trim(Cells(i, SuchSpalte).Value)
   If UCase(Cells(i, SuchSpalte).Value) = "B" Then
      UserForm2.ListFehl.AddItem Cells(i, 1).Value & "      Bezahlte Freizeit"
      u = u + 1
   End If
Next i
For i = 3 To 154
   ChkStr = Trim(Cells(i, SuchSpalte).Value)
   If UCase(Cells(i, SuchSpalte).Value) = "A" Then
      UserForm2.ListFehl.AddItem Cells(i, 1).Value & "      Andere Abwesenheit"
      u = u + 1
   End If
Next i


For i = 3 To 154
   ChkStr = Trim(Cells(i, SuchSpalte).Value)
   If UCase(Cells(i, SuchSpalte).Value) = "ZA" Then
      UserForm2.ListFehl.AddItem Cells(i, 1).Value & "      Zeitausgleich"
      u = u + 1
   End If
Next i


If u > 0 Then
   MyArr(0) = 1
End If
If k > 0 Then
   MyArr(1) = 1
End If

If MyArr(0) = 0 And MyArr(1) = 0 Then 'kein Urlaub, keine Krankmeldung
      MA_Fehl.Visible = True
      ListFehl.Visible = False
      'MyLabel.Caption = "Keine Urlaubs- oder" & vbCrLf & "Krankmeldung"
      MyLabel.Caption = "Niemand abwesend " '& vbCrLf & "Krankmeldung"



ElseIf MyArr(0) > 0 And MyArr(1) > 0 Then
      MA_Fehl.Visible = True
      ListFehl.Visible = True
      'MyLabel.Caption = "Krank- und" & vbCrLf & "Abwesenheit:"
      MyLabel.Caption = "Abwesende Mitarbeiter(innen)" & vbCrLf ' & "Abwesenheit:"

ElseIf MyArr(0) = 0 And MyArr(1) > 0 Then
      MA_Fehl.Visible = True
      ListFehl.Visible = True
      MyLabel.Caption = "Krankmeldung:"
ElseIf MyArr(0) > 0 And MyArr(1) = 0 Then
      MA_Fehl.Visible = True
      ListFehl.Visible = True
      MyLabel.Caption = "Abwesenheit:"
End If
MyArr(0) = 0
MyArr(1) = 0
Application.ScreenUpdating = True
End Sub

Private Sub ComboBoxDatum_Change()
If ComboBoxSchicht.Value <> "" And ComboBoxDatum.Value <> "" Then
    Call Loesche_Form
    Call Fuelle_Form
ElseIf ComboBoxDatum.Value <> "" Then
    If MA_Fehl.Visible = False Then
       CB_Ein.Enabled = True
    Else
       CB_Ein_Click
    End If
End If
End Sub

Private Sub ComboBoxSchicht_Change()
If ComboBoxDatum.Value <> "" And ComboBoxSchicht.Value <> "" Then
   Call Loesche_Form
   Call Fuelle_Form
End If
End Sub

Private Sub UserForm_Initialize()
Application.EnableEvents = False
  
 '###################################################################################
  'Userform wird auf die Größe von Excel gezoomt, wobei die
  'die Controls entsprechend gezoomt und zentriert werden.
  'Uwe Küstner 20070622
  
  Dim Faktor As Single
  Dim x As Single, Y As Single
  Dim sngL As Single, sngO As Single, sngR As Single, sngU As Single
  Dim oC As MSForms.Control
  
  Faktor = Application.Height / (Me.Height - 20)
  If Faktor < 0.1 Then Faktor = 0.1
  If Faktor > 4 Then Faktor = 4
  Me.Width = Application.Width
  Me.Height = Application.Height
  sngL = Me.Width
  sngO = Me.Height
  For Each oC In Me.Controls
    sngL = Application.WorksheetFunction.Min(sngL, oC.Left)
    sngO = Application.WorksheetFunction.Min(sngO, oC.Top)
    sngR = Application.WorksheetFunction.Max(sngR, oC.Left + oC.Width)
    sngU = Application.WorksheetFunction.Max(sngU, oC.Top + oC.Height)
  Next oC
  x = (Me.Width - (sngR * Faktor) - (sngL * Faktor)) / 2 / Faktor
  Y = (Me.Height - (sngO * Faktor) - (sngU * Faktor) - 20) / 2 / Faktor
  Me.Controls.Move x, Y
  Me.Zoom = Faktor * 100

'########################################################################################

Set Sh = ActiveSheet
For Each v In Sh.Range("C1:AG1")
    On Error GoTo skip_Error
    If v <> "" Then
        ComboBoxDatum.AddItem v
    End If
skip_Error:
On Error GoTo 0
Next
If Month(ActiveSheet.Range("a1").Value) = Month(Date) Then
    ComboBoxDatum.ListIndex = Day(Date) - 1
End If
Set Sh = ActiveSheet
For v = 1 To 3
    ComboBoxSchicht.AddItem v
Next
With UF
   .MaxButton = True
   .MinButton = True
   .BorderStyle = xlFest
   .Create Me

End With
ComboBoxSortierer1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer4_4.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer5_5.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer6_6.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer7_7.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer8_8.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer9_9.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer10_10.RowSource = "Personalbesetzung!B51:B66"
ComboBoxAnlernen1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxAnlernen2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxAnlernen3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxFerialarbeiter1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxFerialarbeiter2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxFerialarbeiter3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxZusätzliche_MA1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxZusätzliche_MA2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxZusätzliche_MA3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxRegie1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxRegie2_2.RowSource = "Personalbesetzung!B51:B66"

ComboBoxSchichtMeister.RowSource = "Personalbesetzung!B80:B87" 'Schichtmeister
 Application.EnableEvents = True

End Sub
Sub Fuelle_Form()
Dim SuchSpalte As Long, i As Long, j As Long, k As Long, L As Long, R As Long, A As Long
Dim ChkStr As Variant, HTyp As String, MAZahl As Long, MAhide As Long
Dim ci As Long

Application.EnableEvents = False
A = 1
j = 1
k = 1
L = 1
R = 1
MAZahl = 0
MAhide = 0
SuchSpalte = ComboBoxDatum.ListIndex + 3 'listindex startet mit 0!!
'suche Vorarbeiter
For i = 3 To 154
ChkStr = Trim(Cells(i, SuchSpalte).Value)
StrAuswertung:
If Not ChkStr = "" Then
'Sonderzeiten auswerten
On Error Resume Next
ChkStr = Val(ChkStr)
On Error GoTo 0
If Not WorksheetFunction.IsNumber(ChkStr) Then
HTyp = UCase(Left(ChkStr, 1))
Select Case HTyp
Case "Ü" 'Überstunden
HTyp = "Überstunden"
ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
GoTo StrAuswertung
Case "E" 'Einbringstunden
HTyp = "Einbringstunden"
ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
GoTo StrAuswertung
Case "Z" 'Zeitausgleich
HTyp = "Arbeitet auf Zeitausgleich"
ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
GoTo StrAuswertung
Case Else
' falls noch ein anderer Stundentyp bearbeitet werden soll diesen hier definieren
End Select
If Len(HTyp) = 1 Then
HTyp = ""
End If
End If
'Debug.Print "Chkstr " & ChkStr & " is number: " & WorksheetFunction.IsNumber(ChkStr)
'Hier Regie und Anlerner
If ChkStr = 7 Then 'Regie
Debug.Print ChkStr
If 1 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxRegie" & R Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
R = R + 1
End If
Next ci
End If
ElseIf ChkStr = 4 Then 'Anlerner Schicht1
Debug.Print ChkStr
If 1 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
A = A + 1
End If
Next ci
End If
ElseIf ChkStr = 4 Then
Debug.Print ChkStr
If 2 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
A = A + 1
End If
Next ci
End If
ElseIf ChkStr = 4 Then
Debug.Print ChkStr
If 3 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
A = A + 1
End If
Next ci
End If
ElseIf Len(ChkStr) = 2 And Mid(ChkStr, 1, 1) = 1 Then
'hier die Vorarbeiter
'Debug.Print chkstr
If CStr(Right(ChkStr, 1)) = ComboBoxSchicht.Value Then
ComboBoxVorarbeiter.Value = Cells(i, 1).Value
ComboBoxVorarbeiter.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
If HTyp <> "" Then
TextBoxVorarbeiter.Value = HTyp
TextBoxVorarbeiter.BackColor = &HFFFFFF
Else
TextBoxVorarbeiter.BackColor = &HE0E0E0
End If
End If
ElseIf CStr(ChkStr) = ComboBoxSchicht.Value Then
'hier die Sortierer
If j < 11 Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxSortierer" & j Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
End If
Next ci
If HTyp <> "" Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxSortierer" & j Then
UserForm2.Controls.Item(ci).Value = HTyp
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
ci = UserForm2.Controls.Count - 1
End If
Next ci
Else
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxSortierer" & j Then
Debug.Print UserForm2.Controls.Item(ci).Name
UserForm2.Controls.Item(ci).BackColor = &HE0E0E0
ci = UserForm2.Controls.Count - 1
End If
Next ci
End If
Else
MAhide = MAhide + 1
End If
j = j + 1
ElseIf ChkStr = 20 + ComboBoxSchicht.Value Then
'hier der Schrumpfer
ComboBoxSchrumpfer.Value = Cells(i, 1).Value
ComboBoxSchrumpfer.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
If HTyp <> "" Then
TextBoxSchrumpfer.Value = HTyp
TextBoxSchrumpfer.BackColor = &HFFFFFF
Else
TextBoxSchrumpfer.BackColor = &HE0E0E0
End If
ElseIf ChkStr = "S" And ComboBoxSchicht.Value = 1 Then
'hier der Schrumpfer Springer
ComboBoxSchrumpfer_Springer.Value = Cells(i, 1).Value
ComboBoxSchrumpfer_Springer.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ElseIf Left(ChkStr, 1) = 3 And Right(ChkStr, 1) = ComboBoxSchicht.Value Then
'hier Qualitaetssicherung
ComboBoxQS.Value = Cells(i, 1).Value
ComboBoxQS.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
If HTyp <> "" Then
TextBoxQS.Value = HTyp
TextBoxQS.BackColor = &HFFFFFF
Else
TextBoxQS.BackColor = &HE0E0E0
End If
End If
HTyp = ""
End If
Next i
For i = 184 To 199
'Das ist der Bereich fuer die Ferialarbeiter

If Left(Cells(i, SuchSpalte).Value, 1) = ComboBoxSchicht.Value Then
'hier die Ferialarbeiter
If L < 4 Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxFerialarbeiter" & L Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
End If
Next ci
If HTyp <> "" Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxFerialarbeiter" & L Then
UserForm2.Controls.Item(ci).Value = HTyp
UserForm2.Controls.Item(ci).BackColor = "H00FFFFFF&"
ci = UserForm2.Controls.Count - 1
End If
Next ci
Else
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxFerialarbeiter" & L Then
UserForm2.Controls.Item(ci).BackColor = &HE0E0E0
ci = UserForm2.Controls.Count - 1
End If
Next ci
End If
Else
MAhide = MAhide + 1
End If
L = L + 1
End If
Next i
Application.EnableEvents = True
End Sub Sub Loesche_Form()
Dim ci As Long
Application.EnableEvents = False
For ci = 0 To UserForm2.Controls.Count - 1
Debug.Print UserForm2.Controls.Item(ci).Name
If InStr(1, UserForm2.Controls.Item(ci).Name, "TextBox") <> 0 Or InStr(1, UserForm2.Controls.Item(ci).Name, "ComboBox") Then
If InStr(1, UserForm2.Controls.Item(ci).Name, "Datum") = 0 And InStr(1, UserForm2.Controls.Item(ci).Name, "Schicht") = 0 Then
UserForm2.Controls.Item(ci).Value = ""
Debug.Print UserForm2.Controls.Item(ci).Name
Debug.Print Right(UserForm2.Controls.Item(ci).Name, Len(UserForm2.Controls.Item(ci).Name) - 7)
If Right(UserForm2.Controls.Item(ci).Name, Len(UserForm2.Controls.Item(ci).Name) - 7) > 23 Then
UserForm2.Controls.Item(ci).BackColor = &HE0E0E0
End If
End If
End If
Next ci
Application.EnableEvents = True

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
UserForm2.Hide
Unload UserForm2
End Sub
Private Sub CommandButton1_Click()
  
Sheets("Personalbesetzung").Unprotect Password:="vetro"
'Sheets("Personaldruck").Unprotect Password:="vetro"
'Sheets("Personaldruck").Range("E5,G5,M5,O5,D6:D7,L6:L7,D9:G31,B20:C24,L9:O31,J20:K24"). _
ClearContents 'Ausfüllbereiche leeren

'Sheets("Personaldruck").Protect Password:="vetro"
  
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False
   
   If ComboBoxSchicht.Text = "" Then
MsgBox "Sie haben keine Schicht ausgewählt"
Exit Sub
End If
   If ComboBoxDatum.Text = "" Then
MsgBox "Sie haben kein Datum ausgewählt"
Exit Sub
End If
   If ComboBoxSchichtMeister.Text = "" Then
MsgBox "Sie haben keinen Schichtmeister ausgewählt"
Exit Sub
End If

   If ComboBoxQS.Text = "" Then
MsgBox "Die QS ist nicht besetzt"
Exit Sub
End If

   If ComboBoxSchrumpfer.Text = "" Then
MsgBox "Kein Schrumpfer"
Exit Sub
End If

   If ComboBoxVorarbeiter.Text = "" Then
MsgBox "Kein Vorarbeiter"
Exit Sub
End If

   If ComboBoxSortierer1_1.Text = "" Then
MsgBox "Keine Sortierer"
Exit Sub
End If



Dim ZeileReserve As Long, iIndex As Long
  Me.Hide
  With Sheets("Personalbesetzung")
    .Unprotect Password:="vetro"
    'Ausfüllbereiche leeren
    .Range("E9:V26").ClearContents
    .Range("P27:R35").ClearContents
    .Range("C21:D26").ClearContents
    .Range("C28:O31").ClearContents
    .Range("S27:V31").ClearContents
    .Range("D9:D20").ClearContents
    .Range("F27:H27").ClearContents
    .Range("F32:J32").ClearContents
    .Range("C33:O34").ClearContents
    .Range("S33:V33").ClearContents
    .Range("B9:B37").ClearContents
    
    .Range("A9:V38").Interior.ColorIndex = xlNone
    
    
    
    
    ZeileReserve = 20 'Zeilenzähler für Reserve-Personal
    .Range("Q5") = ComboBoxDatum 'Datum
    .Range("U5") = ComboBoxSchicht 'Schicht
    .Range("F7") = ComboBoxSchichtMeister 'Schichtmeister
    .Range("E32") = ComboBoxSchrumpfer 'Schrumpfer
    .Range("E27") = ComboBoxQS 'QS
    .Range("K5") = ComboBoxVorarbeiter 'Vorarbeiter
    
    
    'Sortierer 1 bis 10
    For iIndex = 1 To 10
      If fncPersonal(sName:=Me.Controls("ComboBoxSortierer" & j + iIndex).Value, _
                  sTaetigkeit:=Me.Controls("ComboBoxSortierer" & j + iIndex).Value, _
                  lZeile:=ZeileReserve) = True Then Me.Show: Exit Sub
    Next
    'Anlerner 1
    Call fncPersonal(sName:=ComboBoxAnlernen1, sTaetigkeit:=ComboBoxAnlernen1_1, lZeile:= _
ZeileReserve)
    'Anlerner 2
    Call fncPersonal(sName:=ComboBoxAnlernen2, sTaetigkeit:=ComboBoxAnlernen2_2, lZeile:= _
ZeileReserve)
    'Anlerner 3
    Call fncPersonal(sName:=ComboBoxAnlernen3, sTaetigkeit:=ComboBoxAnlernen3_3, lZeile:= _
ZeileReserve)
    
    
    'Ferialarbeiter 1 bis 3
    For iIndex = 1 To 3
      If fncPersonal(sName:=Me.Controls("TextBoxFerialarbeiter" & L + iIndex).Value, _
                  sTaetigkeit:=Me.Controls("ComboBoxFerialarbeiter" & L + iIndex).Value, _
                  lZeile:=ZeileReserve) = True Then Me.Show: Exit Sub
    Next

    Unload Me
    .Range("A1").Copy
    .Range("A1").PasteSpecial xlPasteFormats
    Sheets("Personalbesetzung").Select
    Application.CutCopyMode = False
  End With

With Sheets("Personalbesetzung")
    .Protect Password:="vetro"
End With
With Sheets("Personaldruck")
    .Unprotect Password:="vetro"
End With


Worksheets("Personalbesetzung").Range("Q5").Copy
Worksheets("Personaldruck").Range("M5,E5").PasteSpecial Paste:=xlValues 'Datum

Worksheets("Personalbesetzung").Range("U5").Copy
Worksheets("Personaldruck").Range("G5,O5").PasteSpecial Paste:=xlValues 'Schicht

Worksheets("Personalbesetzung").Range("K5").Copy
Worksheets("Personaldruck").Range("D7,L7").PasteSpecial Paste:=xlValues 'Vorarbeiter

Worksheets("Personalbesetzung").Range("F7").Copy
Worksheets("Personaldruck").Range("D6,L6").PasteSpecial Paste:=xlValues 'Schichtmeister

Worksheets("Personalbesetzung").Range("E10").Copy
Worksheets("Personaldruck").Range("D9").PasteSpecial Paste:=xlValues 'L:311+P:

Worksheets("Personalbesetzung").Range("G10").Copy
Worksheets("Personaldruck").Range("F9,N9").PasteSpecial Paste:=xlValues 'L:311+P:

Worksheets("Personalbesetzung").Range("E11").Copy
Worksheets("Personaldruck").Range("D10,L10").PasteSpecial Paste:=xlValues 'L:312+P:

Worksheets("Personalbesetzung").Range("G11").Copy
Worksheets("Personaldruck").Range("F10,N10").PasteSpecial Paste:=xlValues 'L:312+P:

Worksheets("Personalbesetzung").Range("E12").Copy
Worksheets("Personaldruck").Range("D11,L11").PasteSpecial Paste:=xlValues 'L:321+P:+322+P:

Worksheets("Personalbesetzung").Range("G12").Copy
Worksheets("Personaldruck").Range("F11,N11").PasteSpecial Paste:=xlValues 'L:321+P:+322+P:

Worksheets("Personalbesetzung").Range("E13").Copy
Worksheets("Personaldruck").Range("D12,L12").PasteSpecial Paste:=xlValues 'L:321+P:

Worksheets("Personalbesetzung").Range("G13").Copy
Worksheets("Personaldruck").Range("F12,N12").PasteSpecial Paste:=xlValues 'L:321+P:

Worksheets("Personalbesetzung").Range("E14").Copy
Worksheets("Personaldruck").Range("D13,L13").PasteSpecial Paste:=xlValues 'L:322+P:

Worksheets("Personalbesetzung").Range("G14").Copy
Worksheets("Personaldruck").Range("F13,N13").PasteSpecial Paste:=xlValues 'L:312+P:

Worksheets("Personalbesetzung").Range("E15").Copy
Worksheets("Personaldruck").Range("D14,L14").PasteSpecial Paste:=xlValues 'L:331+P:+332+P:

Worksheets("Personalbesetzung").Range("G15").Copy
Worksheets("Personaldruck").Range("F14,N14").PasteSpecial Paste:=xlValues 'L:331+P:+332+P:

Worksheets("Personalbesetzung").Range("E16").Copy
Worksheets("Personaldruck").Range("D15,L15").PasteSpecial Paste:=xlValues 'L:331+P:

Worksheets("Personalbesetzung").Range("G16").Copy
Worksheets("Personaldruck").Range("F15,N15").PasteSpecial Paste:=xlValues 'L:331+P:

Worksheets("Personalbesetzung").Range("E17").Copy
Worksheets("Personaldruck").Range("D16,L16").PasteSpecial Paste:=xlValues 'L:332+P:+333+P:

Worksheets("Personalbesetzung").Range("G17").Copy
Worksheets("Personaldruck").Range("F16,N16").PasteSpecial Paste:=xlValues 'L:332+P:+333+P:

Worksheets("Personalbesetzung").Range("E18").Copy
Worksheets("Personaldruck").Range("D17,L17").PasteSpecial Paste:=xlValues 'L:332+P

Worksheets("Personalbesetzung").Range("G18").Copy
Worksheets("Personaldruck").Range("F17,N17").PasteSpecial Paste:=xlValues 'L:332+P

Worksheets("Personalbesetzung").Range("E19").Copy
Worksheets("Personaldruck").Range("D18,L18").PasteSpecial Paste:=xlValues 'L:333+P:

Worksheets("Personalbesetzung").Range("G19").Copy
Worksheets("Personaldruck").Range("F18,N18").PasteSpecial Paste:=xlValues 'L:333+P:

Worksheets("Personalbesetzung").Range("C21").Copy
Worksheets("Personaldruck").Range("D19,L19").PasteSpecial Paste:=xlValues 'Reserve1

Worksheets("Personalbesetzung").Range("C22").Copy
Worksheets("Personaldruck").Range("F19,N19").PasteSpecial Paste:=xlValues 'Reserve2

Worksheets("Personalbesetzung").Range("C23").Copy
Worksheets("Personaldruck").Range("B20,J20").PasteSpecial Paste:=xlValues 'Reserve3

Worksheets("Personalbesetzung").Range("C24").Copy
Worksheets("Personaldruck").Range("D20,L20").PasteSpecial Paste:=xlValues 'Reserve4

Worksheets("Personalbesetzung").Range("C25").Copy
Worksheets("Personaldruck").Range("F20,N20").PasteSpecial Paste:=xlValues 'Reserve5

Worksheets("Personalbesetzung").Range("C26").Copy
Worksheets("Personaldruck").Range("B21,J21").PasteSpecial Paste:=xlValues 'Reserve6

Worksheets("Personalbesetzung").Range("E27").Copy
Worksheets("Personaldruck").Range("D25,L25").PasteSpecial Paste:=xlValues 'QS

Worksheets("Personalbesetzung").Range("E28").Copy
Worksheets("Personaldruck").Range("D26,L26").PasteSpecial Paste:=xlValues 'QS Anlernen

Worksheets("Personalbesetzung").Range("E32").Copy
Worksheets("Personaldruck").Range("D29,L29").PasteSpecial Paste:=xlValues 'Schrumpfer

Worksheets("Personalbesetzung").Range("E33").Copy
Worksheets("Personaldruck").Range("D30,L30").PasteSpecial Paste:=xlValues 'Schrumpfer Anlernen

   'Linie 311
   If Range("E10") <> "" Then
   Range("C10") = "L:311+P:"
   End If
   
   If Range("G10") <> "" Then
   Range("C10") = "L:311+P:"
   End If
   
   If Range("E10") <> "" Then
   Range("I10") = 8
   End If
   
   If Range("G10") <> "" Then
   Range("I10") = 8
   End If
   
   If Range("E10") <> "" And Range("G10") <> "" Then
   Range("I10") = 16
  End If
   
   'Linie 312
   If Range("E11") <> "" Then
   Range("C11") = "L:312+P:"
   End If
   
   If Range("E11") <> "" Then
   Range("J11") = 8
   End If
   
   If Range("G11") <> "" Then
   Range("J11") = 8
   End If
   
   If Range("E11") <> "" And Range("G11") <> "" Then
   Range("J11") = 16
  End If
   
   'Linie 321+322
   If Range("E12") <> "" Then
   Range("C12") = "L:321+P:+322+P:"
   End If
   
   If Range("G12") <> "" Then
   Range("C12") = "L:321+P:+322+P:"
   End If
   
   If Range("E12") <> "" Then
   Range("K12") = 4
   End If
    
   If Range("G12") <> "" Then
   Range("K12") = 4
   End If
   
   If Range("E12") <> "" Then
   Range("L12") = 4
   End If
   
   If Range("E12") <> "" And Range("G12") <> "" Then
   Range("K12") = 8
  End If
   
   If Range("E12") <> "" And Range("G12") <> "" Then
   Range("L12") = 8
  End If
   
   'Linie 321
   
   If Range("E13") <> "" Then
   Range("C13") = "L:321+P:"
   End If
   
   If Range("G13") <> "" Then
   Range("C13") = "L:321+P:"
   End If
   
   If Range("E13") <> "" Then
   Range("K13") = 8
   End If
   
   If Range("G13") <> "" Then
   Range("K13") = 8
   End If
   
   If Range("E13") <> "" And Range("G13") <> "" Then
   Range("K13") = 16
  End If

   'Linie 322
   If Range("E14") <> "" Then
   Range("C14") = "L:322+P:"
   End If
   
   If Range("G14") <> "" Then
   Range("C14") = "L:322+P:"
   End If
   
   If Range("E14") <> "" Then
   Range("L14") = 8
   End If
   
   If Range("G14") <> "" Then
   Range("L14") = 8
   End If
   
   If Range("E14") <> "" And Range("G14") <> "" Then
   Range("L14") = 16
  End If
   
   'Linie 331+332
   If Range("E15") <> "" Then
   Range("C15") = "L:331+P:+332+P:"
   End If
   
   If Range("G15") <> "" Then
   Range("C15") = "L:331+P:+332+P:"
   End If
   
   If Range("E15") <> "" Then
   Range("M15") = 6
   End If
   
   If Range("E15") <> "" Then
   Range("N15") = 2
   End If
  
   'Linie 331
   If Range("E16") <> "" Then
   Range("C16") = "L:331+P:"
   End If
   
   If Range("G16") <> "" Then
   Range("C16") = "L:331+P:"
   End If
   
   If Range("E16") <> "" Then
   Range("M16") = 8
   End If
  
   If Range("E16") <> "" And Range("G16") <> "" Then
   Range("M16") = 16
  End If
  
   'Linie 332+333
   If Range("E17") <> "" Then
   Range("C17") = "L:332+P:+333+P:"
   End If
   
   If Range("G17") <> "" Then
   Range("C17") = "L:332+P:+333+P:"
   End If
   
   If Range("E17") <> "" Then
   Range("N17") = 6
   End If
   
   If Range("E17") <> "" Then
   Range("O17") = 2
   End If
  
   'Linie 332
   If Range("E18") <> "" Then
   Range("C18") = "L:332+P:"
   End If
   
   If Range("G18") <> "" Then
   Range("C18") = "L:332+P:"
   End If
   
   If Range("E18") <> "" Then
   Range("N18") = 8
   End If
  
   If Range("E18") <> "" And Range("G18") <> "" Then
   Range("N18") = 16
  End If
  
   'Linie 333
   If Range("E19") <> "" Then
   Range("C19") = "L:332+P:"
   End If
   
   If Range("G19") <> "" Then
   Range("C19") = "L:332+P:"
   End If
   
   If Range("E19") <> "" Then
   Range("O19") = 8
   End If
  
   If Range("E19") <> "" And Range("G19") <> "" Then
   Range("O19") = 16
  End If
   
   'Reserve1
   If Range("C21") <> "" Then
   Range("P21") = 8
   End If
  
   If Range("C22") <> "" Then
   Range("P22") = 8
   End If
  
   'Reserve3
   If Range("C23") <> "" Then
   Range("P23") = 8
   End If
  
   'Reserve4
   If Range("C24") <> "" Then
   Range("P24") = 8
   End If
  
   'Reserve5
   If Range("C25") <> "" Then
   Range("P25") = 8
   End If
  
   'QS Anlernen
   If Range("E28") <> "" Then
   Range("C28") = "QS Anlernen:"
   End If
  
   If Range("E28") <> "" Then
   Range("I28") = 1
   End If
  
   If Range("E28") <> "" Then
   Range("J28") = 2
   End If
  
   If Range("E28") <> "" Then
   Range("K28") = 1
   End If
   
   If Range("E28") <> "" Then
   Range("L28") = 1
   End If
   
   If Range("E28") <> "" Then
   Range("M28") = 1
   End If
  
   If Range("E28") <> "" Then
   Range("N28") = 1
   End If
    
   If Range("E28") <> "" Then
   Range("O28") = 1
   End If
    
   'Schrumpfer Anlernen
   If Range("E33") <> "" Then
   Range("C33") = "Schrumpfer Anl.:"
   End If

   If Range("E33") <> "" Then
   Range("K33") = 0.5
   End If
   If Range("E33") <> "" Then
   Range("L33") = 0.5
   End If

   If Range("E33") <> "" Then
   Range("N33") = 0.5
   End If
   
   If Range("E33") <> "" Then
   Range("O33") = 0.5
   End If
   
   If Range("E33") <> "" Then
   Range("K33") = 0.5
   End If

   If Range("E33") <> "" Then
   Range("S33") = "MSK"
   End If

   If Range("E33") <> "" Then
   Range("V33") = 6
   End If


  ''Call CopySchichtliste


If MsgBox("Soll gedruckt werden ?", vbYesNo + vbQuestion, "Druckabfrage ?") = vbNo Then
Exit Sub
End If
Worksheets("Personaldruck").PrintOut Copies:=1, Collate:=True
        Cancel = True
Worksheets("Personalbesetzung").Range("Y5").Select
  
  Application.ScreenUpdating = True
  Application.EnableEvents = True

End Sub

Private Function fncPersonal(sName As String, sTaetigkeit As String, _
            Optional lZeile As Long) As Boolean
  If sName = "" Or sTaetigkeit = "" Then Exit Function
  With Sheets("Personalbesetzung")
    Select Case sTaetigkeit
      Case "311":        fncPersonal = Eintragen(zeile:=10, sText:=sName)
      Case "312":        fncPersonal = Eintragen(zeile:=11, sText:=sName)
      Case "321+322": fncPersonal = Eintragen(zeile:=12, sText:=sName)
      Case "321":        fncPersonal = Eintragen(zeile:=13, sText:=sName)
      Case "322":         fncPersonal = Eintragen(zeile:=14, sText:=sName)
      Case "331+332": fncPersonal = Eintragen(zeile:=15, sText:=sName)
      Case "331":        fncPersonal = Eintragen(zeile:=16, sText:=sName)
      Case "332+333": fncPersonal = Eintragen(zeile:=17, sText:=sName)
      
      
      Case "L:332":        fncPersonal = Eintragen(zeile:=18, sText:=sName)
      Case "L:333":        fncPersonal = Eintragen(zeile:=19, sText:=sName)
      
      Case "Reserve"
        lZeile = lZeile + 1
        .Cells(lZeile, 3) = sName
      Case ""
        'do nothing
      Case "QS Anlernen":         .Cells(28, 5) = sName
      
      'Case "Schrumpfer": .Cells(32, 5) = sName
      Case "Schrumpfer Anlernen": .Cells(33, 5) = sName
      Case Else
        MsgBox "Für die Auswahl """ & sTaetigkeit _
            & """ Fehlt noch eine Case-Zeile im Makro"
    End Select
  End With
End Function
Function Eintragen(ByVal zeile As Long, ByVal sText As String) As Boolean
'Name Eintragen für Maschine in Spalte E oder G
Dim lSpalte As Long
lSpalte = 5
With Sheets("Personalbesetzung")
If .Cells(zeile, lSpalte) = "" Then '1. Name für Maschine
.Cells(zeile, lSpalte) = sText
ElseIf .Cells(zeile, lSpalte + 2) = "" Then '2. Name für Maschine
.Cells(zeile, lSpalte + 2) = sText
Else
MsgBox "Für Linie """ & .Cells(zeile, 3) & """ soll als 3. Person """ _
& sText & " eingetragen werden." & vbLf & vbLf _
& "Bitte Eingabe korrigieren!", vbOKOnly + vbInformation, "Personalbesetzung ausfüllen"
Eintragen = True
End If
End With
End Function
Private Sub ComboBoxSortierer1_Change() 'Sortierer 1
Me.ComboBoxSortierer1_1.Visible = Len(Me.ComboBoxSortierer1)
Me.TextBoxSortierer1.Visible = Len(Me.ComboBoxSortierer1)
End Sub
Private Sub ComboBoxSortierer2_Change() 'Sortierer 2
Me.ComboBoxSortierer2_2.Visible = Len(Me.ComboBoxSortierer2)
Me.TextBoxSortierer2.Visible = Len(Me.ComboBoxSortierer2)
End Sub
Private Sub ComboBoxSortierer3_Change() 'Sortierer 3
Me.ComboBoxSortierer3_3.Visible = Len(Me.ComboBoxSortierer3)
Me.TextBoxSortierer3.Visible = Len(Me.ComboBoxSortierer3)
End Sub
Private Sub ComboBoxSortierer4_Change() 'Sortierer 4
Me.ComboBoxSortierer4_4.Visible = Len(Me.ComboBoxSortierer4)
Me.TextBoxSortierer4.Visible = Len(Me.ComboBoxSortierer4)
End Sub
Private Sub ComboBoxSortierer5_Change() 'Sortierer 5
Me.ComboBoxSortierer5_5.Visible = Len(Me.ComboBoxSortierer5)
Me.TextBoxSortierer5.Visible = Len(Me.ComboBoxSortierer5)
End Sub
Private Sub ComboBoxSortierer6_Change() 'Sortierer 6
Me.ComboBoxSortierer6_6.Visible = Len(Me.ComboBoxSortierer6)
Me.TextBoxSortierer6.Visible = Len(Me.ComboBoxSortierer6)
End Sub
Private Sub ComboBoxSortierer7_Change() 'Sortierer 7
Me.ComboBoxSortierer7_7.Visible = Len(Me.ComboBoxSortierer7)
Me.TextBoxSortierer7.Visible = Len(Me.ComboBoxSortierer7)
End Sub
Private Sub ComboBoxSortierer8_Change() 'Sortierer 8
Me.ComboBoxSortierer8_8.Visible = Len(Me.ComboBoxSortierer8)
Me.TextBoxSortierer8.Visible = Len(Me.ComboBoxSortierer8)
End Sub
Private Sub ComboBoxSortierer9_Change() 'Sortierer 9
Me.ComboBoxSortierer9_9.Visible = Len(Me.ComboBoxSortierer9)
Me.TextBoxSortierer9.Visible = Len(Me.ComboBoxSortierer9)
End Sub
Private Sub ComboBoxSortierer10_Change() 'Sortierer 10
Me.ComboBoxSortierer10_10.Visible = Len(Me.ComboBoxSortierer10)
Me.TextBoxSortierer10.Visible = Len(Me.ComboBoxSortierer10)
End Sub
Private Sub ComboBoxAnlernen1_Change() 'Anlernen 1
Me.ComboBoxAnlernen1_1.Visible = Len(Me.ComboBoxAnlernen1)
Me.TextBoxAnlernen1.Visible = Len(Me.ComboBoxAnlernen1)
End Sub
Private Sub ComboBoxAnlernen2_Change() 'Anlernen 2
Me.ComboBoxAnlernen2_2.Visible = Len(Me.ComboBoxAnlernen2)
Me.TextBoxAnlernen2.Visible = Len(Me.ComboBoxAnlernen2)
End Sub
Private Sub ComboBoxAnlernen3_Change() 'Anlernen 3
Me.ComboBoxAnlernen3_3.Visible = Len(Me.ComboBoxAnlernen3)
Me.TextBoxAnlernen3.Visible = Len(Me.ComboBoxAnlernen3)
End Sub
Private Sub ComboBoxFerialarbeiter1_Change() 'Ferialarbeiter 1
Me.ComboBoxFerialarbeiter1_1.Visible = Len(Me.ComboBoxFerialarbeiter1)
Me.TextBoxFerialarbeiter1.Visible = Len(Me.ComboBoxFerialarbeiter1)
End Sub
Private Sub ComboBoxFerialarbeiter2_Change() 'Ferialarbeiter 2
Me.ComboBoxFerialarbeiter2_2.Visible = Len(Me.ComboBoxFerialarbeiter2)
Me.TextBoxFerialarbeiter2.Visible = Len(Me.ComboBoxFerialarbeiter2)
End Sub
Private Sub ComboBoxFerialarbeiter3_Change() 'Ferialarbeiter 3
Me.ComboBoxFerialarbeiter3_3.Visible = Len(Me.ComboBoxFerialarbeiter3)
Me.TextBoxFerialarbeiter3.Visible = Len(Me.ComboBoxFerialarbeiter3)
End Sub
Private Sub ComboBoxZusätzliche_MA1_Change() 'Zusätzliche MA 1
Me.ComboBoxZusätzliche_MA1_1.Visible = Len(Me.ComboBoxZusätzliche_MA1)
End Sub
Private Sub ComboBoxZusätzliche_MA2_Change() 'Zusätzliche MA 2
Me.ComboBoxZusätzliche_MA2_2.Visible = Len(Me.ComboBoxZusätzliche_MA2)
End Sub
Private Sub ComboBoxZusätzliche_MA3_Change() 'Zusätzliche MA 3
Me.ComboBoxZusätzliche_MA3_3.Visible = Len(Me.ComboBoxZusätzliche_MA3)
End Sub
Private Sub ComboBoxRegie1_Change() 'Regie 1
Me.ComboBoxRegie1_1.Visible = Len(Me.ComboBoxRegie1)
End Sub
Private Sub ComboBoxRegie2_Change() 'Regie 2
Me.ComboBoxRegie2_2.Visible = Len(Me.ComboBoxRegie2)
End Sub
'Werte in den Comboboxen anzeigen
Private Sub UserForm_Activate()
  
  With ComboBoxSchrumpfer
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxVorarbeiter
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxQS
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer1
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer2
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer3
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer4
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer5
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer6
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer7
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer8
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer9
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxSortierer10
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxAnlernen1
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxAnlernen2
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxAnlernen3
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
 With ComboBoxZusätzliche_MA1
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxZusätzliche_MA2
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxZusätzliche_MA3
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxRegie1
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxRegie2
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A3:A154"))
  End With
  With ComboBoxFerialarbeiter1
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A188:A202"))
  End With
  With ComboBoxFerialarbeiter2
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A188:A202"))
  End With
  With ComboBoxFerialarbeiter3
    .Clear
    .List = UniqueList(Sheets("Jänner").Range("A188:A202"))
  End With

End Sub

'Werte von Sheets Jänner A3:A154 ohne Null anzeigen
Function UniqueList(Matrix As Range, Optional Sorted As Boolean = True) As Variant
Dim objDic As Object, rng As Range, varTmp() As Variant

Set objDic = CreateObject("Scripting.Dictionary")

For Each rng In Matrix
If rng.Value <> 0 Then objDic(rng.Value) = 0
Next

varTmp = objDic.keys

If Sorted Then QuickSort varTmp

UniqueList = varTmp

Set objDic = Nothing
End Function 'Werte von Sheets Jänner A3:A154 nach ABC sortieren
Private Sub QuickSort(data() As Variant, Optional UG, Optional OG)
  Dim P1&, P2&, T1 As Variant, T2 As Variant
  
  UG = IIf(IsMissing(UG), LBound(data), UG)
  OG = IIf(IsMissing(OG), UBound(data), OG)
  
  P1 = UG
  P2 = OG
  T1 = data((P1 + P2) / 2)
  
  Do
    
    Do While (data(P1) < T1)
      P1 = P1 + 1
    Loop
    
    Do While (data(P2) > T1)
      P2 = P2 - 1
    Loop
    
    If P1 <= P2 Then
      T2 = data(P1)
      data(P1) = data(P2)
      data(P2) = T2
      P1 = P1 + 1
      P2 = P2 - 1
    End If
    
  Loop Until (P1 > P2)
  
  If UG < P2 Then QuickSort data, UG, P2
  If P1 < OG Then QuickSort data, P1, OG
  
End Sub



  

Betrifft: AW: Case Anwendung beim eintragen von: Hajo_Zi
Geschrieben am: 31.12.2011 19:50:19

Hallo Heinz,

Du glaubst doch nicht das dies ohne Datei geht? Ich baue jetzt nicht die nicht nach. Lade die Datei hoch und beschreibe genau was gemacht werden soll auslösenen des Fehlers.

Gruß Hajo


  

Betrifft: AW: Case Anwendung beim eintragen von: Heinz H.
Geschrieben am: 02.01.2012 11:28:49

Hallo
Habe nun die Datei hochgeladen.

Es geht um folgendes:
Wenn ich im "Jänner"auf den Button Schichtpersonal klicke,öffnet die UserForm2.
Nun wähle ich das Datum,die Schicht & Schichtmeister aus.
Wenn ich in der ComboBox bei Sortierer 1 einen Eintrag wähle,und dann auf eintragen klicke,sollten die Werte in den Sheets "Personalbesetzung" eingetragen werden.

Nun kommen aber die Fehlermeldungen das Case Zeile fehlen.

Ich hoffe das ich das ganze verständnissvoll Erklären konnte.

Danke Heinz

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


  

Betrifft: AW: Case Anwendung beim eintragen von: Hajo_Zi
Geschrieben am: 02.01.2012 17:27:17

Hallo Heinz,

soweit komme ich nicht, er bricht schon ab bei einem set --=Activesheet.

Gruß Hajo


  

Betrifft: AW: Case Anwendung beim eintragen von: Heinz H.
Geschrieben am: 02.01.2012 17:58:03

Hallo Hajo

Komisch,bei mir funkt.die hochgeladene Datei.

Gruß
Heinz


  

Betrifft: ..bei mir auch nicht! siehe Hajo.. von: robert
Geschrieben am: 02.01.2012 18:38:04

Hi,
es fehlen einige Dim Anweisungen, bzw.Verweise.

Gruß
robert


  

Betrifft: AW: ..bei mir auch nicht! siehe Hajo.. von: Heinz H.
Geschrieben am: 03.01.2012 09:01:05

Hallo Hajo & Robert

Ist echt komisch.
Lade die ganze Datei mal auf Rapidshare hoch.
Wenn jemand so nett wäre,und von dort die Datei Downloaden würde.
Danke
Heinz

https://rapidshare.com/files/370418980/Dirk_2011.neues_Schema.Test.xls


  

Betrifft: AW: ..bei mir auch nicht! siehe Hajo.. von: Hajo_Zi
Geschrieben am: 03.01.2012 16:54:39

Hallo Heinz,

ich würde vermuten durch das hochladen auf einen anderen Server, werden nicht die Dim Anweisungen in den Code geschrieben. Ich könnte mich da irren. Aber ich lade die nicht runter.

Gruß Hajo


  

Betrifft: AW: ..bei mir auch nicht! siehe Hajo.. von: Heinz H.
Geschrieben am: 03.01.2012 17:14:33

Hallo Hajo

Ich würde vermuten durch das hochladen auf einen anderen Server, werden nicht die Dim Anweisungen in den Code geschrieben.
Damit hast du natürlich zu 100% Recht.
Aber auf dem anderen Server konnte ich die ganze Datei ca.9MB hochladen.
So ist der Fehler besser zum nachverfolgen.

Trozdem recht herzlichen Dank,für dein Feedback,und der Wille zum helfen.

Gruß
Heinz


  

Betrifft: AW: Case Anwendung beim eintragen von: fcs
Geschrieben am: 03.01.2012 09:25:04

Hallo Heinz,


in der Prozedur des CommandButton1 werden die Namen der Comboboxen für die Sortierer und Ferialmitarbeiter und ihre Tätigkeit in den For-Next-Schleifen falsch berechnet. Dadurch wird für die Tätigkeit ebenfalls der Name an die Funktion übergeben, was dann zu der Meldung mit dem fehlenden Case führt.

Durch die Wahl der Namen für die Comboboxen zur Auswahl der Tätigkeit hast du dir das Leben unnötig schwer gemacht.
Statt
ComboxSortierer1_1
ComboxSortierer2_2
usw.
wäre besser
ComboxSortierer_T1 oder ComboxSortierer1_T
ComboxSortierer_T2 oder ComboxSortierer2_T
usw.

Dann wäre die laufende Nummer der Combobox nur einmal im Namen vorhanden.

Gruß
Franz

Textdatei mit korrigiertem Code für den CommandButton1
https://www.herber.de/bbs/user/78186.txt
Die beiden korrigierten Anweisungen im Code hab ich mit einer Bemerkung markiert.


  

Betrifft: AW: Case Anwendung beim eintragen von: Heinz H.
Geschrieben am: 03.01.2012 09:41:47

Hallo Franz

Super !!!
Recht herzlichen D A N K !!!

Durch die Wahl der Namen für die Comboboxen zur Auswahl der Tätigkeit hast du dir das Leben unnötig schwer gemacht.
Werde das nächste mal darauf achten.

Nochmals vielen DANK !

Gruß
Heinz


  

Betrifft: AW: Case Anwendung beim eintragen von: Heinz H.
Geschrieben am: 03.01.2012 10:06:23

Hallo Franz

Bei einer älteren Version ist zB. "E33" oder "Z1" gegangen.
"E33" bedeutet "Einbringschicht in der 3 Schicht Qualitätssicherung"
"Z1" bedeutet "Sortierer arbeitet auf Zeitausgleich in Schicht 1"

Jetzt funktioniert es nur umgekehrt.Also "33E" oder "1Z"

Könntest du bitte nachsehen wo hier der Fehler liegt. Ich bin es schon ca.30 mal durchgegangen,
ohne den Fehler zu entdecken.

Danke
Heinz


  

Betrifft: AW: Case Anwendung beim eintragen von: fcs
Geschrieben am: 03.01.2012 13:04:32

Hallo Heinz,

der Fehler war jetzt sehr tricky versteckt in der Prozedur für das Füllen des Userforms nach Ändern der Schicht-Auswahl bzw. des Datums.
Die alte Zeile
ChkStr = Val(ChkStr)
Wandelt Werte wie "Z1", "E33" oder "Ü2" in den Wert 0 um.

Dadurch wird die nachfolgende Prüfung
If Not WorksheetFunction.IsNumber(ChkStr) Then
nie True und die Werte für HTyp und ChkStr werden nicht neu berechnet für die Sonderzeiten.

Die Tatsache, dass du die Variable "ChkStr" für verschiedene Zwecke verwendest (mal ist sie nummerisch, mal Text) führt hier zur Verwirrung. Es wäre wohl besser/übersichtlicher gewesen für die aus "ChkStr" ermittelte Nummer der Schicht eine eigene Variable zu verwenden.

Gruß
Franz

Sub Fuelle_Form()
Dim SuchSpalte As Long, i As Long, j As Long, k As Long, L As Long, R As Long, A As Long
Dim ChkStr As Variant, HTyp As String, MAZahl As Long, MAhide As Long
Dim ci As Long

Application.EnableEvents = False
A = 1
j = 1
k = 1
L = 1
R = 1
MAZahl = 0
MAhide = 0
SuchSpalte = ComboBoxDatum.ListIndex + 3  'listindex startet mit 0!!
'suche Vorarbeiter
For i = 3 To 154
   ChkStr = Trim(Cells(i, SuchSpalte).Value)
StrAuswertung:
   If Not ChkStr = "" Then
       'Sonderzeiten auswerten
       On Error Resume Next
'       ChkStr = Val(ChkStr)                                  'alte Zeile
       If IsNumeric(ChkStr) Then ChkStr = Val(ChkStr)         'neue Zeile
       On Error GoTo 0
       If Not WorksheetFunction.IsNumber(ChkStr) Then



  

Betrifft: AW: Case Anwendung beim eintragen von: Heinz H.
Geschrieben am: 03.01.2012 16:09:11

Hallo Franz

Du bist echt der GRÖßTE !!
Recht herzlichen D A N K



PS: Es wären paar Kleinigkeiten,die ich leider nicht zusammen bringe.
Wie gesagt Kleinigkeiten.

Aber nur wenn du Lust und Laune hast,dann melde dich bitte bei mir.
heinz_holzmannAT.aon.at

Danke Heinz


  

Betrifft: AW: Anlernen Schicht 2 oder 3 von: Heinz H.
Geschrieben am: 04.01.2012 09:34:40

Hallo Franz

Könntest du mir bitte dazu nochmals weiterhelfen.
Hier geht es um die Anlerner

Wenn eine 4 steht "ElseIf ChkStr = 4 Then 'Anlerner Schicht1"
dann Schicht 1 - Okay das passt.
ABER: Wenn eine 5 steht dann Schicht 2
Wenn eine 6 steht dann Schicht 3

Danke
Heinz

Sub Fuelle_Form()
Dim SuchSpalte As Long, i As Long, j As Long, k As Long, L As Long, R As Long, A As Long
Dim ChkStr As Variant, HTyp As String, MAZahl As Long, MAhide As Long
Dim ci As Long

Application.EnableEvents = False
A = 1
j = 1
k = 1
L = 1
R = 1
MAZahl = 0
MAhide = 0
SuchSpalte = ComboBoxDatum.ListIndex + 3  'listindex startet mit 0!!
'suche Vorarbeiter
For i = 3 To 154
   ChkStr = Trim(Cells(i, SuchSpalte).Value)
StrAuswertung:
   If Not ChkStr = "" Then
       'Sonderzeiten auswerten
       On Error Resume Next
'       ChkStr = Val(ChkStr)                                  'alte Zeile
       If IsNumeric(ChkStr) Then ChkStr = Val(ChkStr)         'neue Zeile
       On Error GoTo 0
       If Not WorksheetFunction.IsNumber(ChkStr) Then
            HTyp = UCase(Left(ChkStr, 1))
            Select Case HTyp
                Case "Ü"   'Überstunden
                    HTyp = "Überstunden"
                    ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
                    GoTo StrAuswertung
                Case "E"   'Einbringstunden
                    HTyp = "Einbringstunden"
                    ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
                    GoTo StrAuswertung
                Case "Z"   'Zeitausgleich
                    HTyp = "Arbeitet auf Zeitausgleich"
                    ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
                    GoTo StrAuswertung
                Case Else
                ' falls noch ein anderer Stundentyp bearbeitet werden soll diesen hier  _
definieren
            End Select
            If Len(HTyp) = 1 Then
               HTyp = ""
            End If
       End If
        'Debug.Print "Chkstr " & ChkStr & " is number: " & WorksheetFunction.IsNumber(ChkStr)
        'Hier Regie und Anlerner
        If ChkStr = 7 Then    'Regie
            Debug.Print ChkStr
            If 1 = Val(ComboBoxSchicht.Value) Then
                For ci = 0 To UserForm2.Controls.Count - 1
                     If UserForm2.Controls.Item(ci).Name = "ComboBoxRegie" & R Then
                         UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
                         UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
                         MAZahl = MAZahl + 1
                         ci = UserForm2.Controls.Count - 1
                         R = R + 1
                     End If
                 Next ci
            End If
        ElseIf ChkStr = 4 Then   'Anlerner Schicht1
            Debug.Print ChkStr
            If 1 = Val(ComboBoxSchicht.Value) Then
                For ci = 0 To UserForm2.Controls.Count - 1
                     If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
                         UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
                         UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
                         MAZahl = MAZahl + 1
                         ci = UserForm2.Controls.Count - 1
                         A = A + 1
                     End If
                 Next ci
            End If
        ElseIf ChkStr = 4 Then
            Debug.Print ChkStr
            If 2 = Val(ComboBoxSchicht.Value) Then
                For ci = 0 To UserForm2.Controls.Count - 1
                     If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
                         UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
                         UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
                         MAZahl = MAZahl + 1
                         ci = UserForm2.Controls.Count - 1
                         A = A + 1
                     End If
                 Next ci
            End If
        ElseIf ChkStr = 4 Then
            Debug.Print ChkStr
            If 3 = Val(ComboBoxSchicht.Value) Then
                For ci = 0 To UserForm2.Controls.Count - 1
                     If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
                         UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
                         UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
                         MAZahl = MAZahl + 1
                         ci = UserForm2.Controls.Count - 1
                         A = A + 1
                     End If
                 Next ci
            End If
        
        
        
        ElseIf ChkStr = 5 Then   'Anlerner Schicht 2
            Debug.Print ChkStr
            If 1 = Val(ComboBoxSchicht.Value) Then
                For ci = 0 To UserForm2.Controls.Count - 1
                     If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
                         UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
                         UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
                         MAZahl = MAZahl + 1
                         ci = UserForm2.Controls.Count - 1
                         A = A + 1
                     End If
                 Next ci
            End If
        ElseIf ChkStr = 5 Then
            Debug.Print ChkStr
            If 2 = Val(ComboBoxSchicht.Value) Then
                For ci = 0 To UserForm2.Controls.Count - 1
                     If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
                         UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
                         UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
                         MAZahl = MAZahl + 1
                         ci = UserForm2.Controls.Count - 1
                         A = A + 1
                     End If
                 Next ci
            End If
        ElseIf ChkStr = 5 Then
            Debug.Print ChkStr
            If 3 = Val(ComboBoxSchicht.Value) Then
                For ci = 0 To UserForm2.Controls.Count - 1
                     If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
                         UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
                         UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
                         MAZahl = MAZahl + 1
                         ci = UserForm2.Controls.Count - 1
                         A = A + 1
                     End If
                 Next ci
            End If
        



Beiträge aus den Excel-Beispielen zum Thema "Case Anwendung beim eintragen"