Hallo Zusammen,
ich brauch dringend eure Hilfe. Ich komm einfach nicht mehr weiter. Vielleicht kann mir einer von euren super Fachleuten mir den Tipp geben das ich weiter komme.
Grundsätzlich: Ich habe nie Excel gelernt, sondern alles immer selber beigebracht. Daher sind meine Datein eher Kreativ als Sinnvoll zu bezeichnen.
Datei: Ich hab eine Datei zur Schichtplanung erstellt die auch gleichzeitig einigen Statistiken befüllt und aber auch eine Platzzordnung. z.B. 5 Mitarbeiter haben Frühschicht, 3 sind an der Kasse, 1 fürs Büro und der letzte muss Putzen. Die datei ist so aufgebaut, das je Spalte der Tag notiert ist und hinter jedem Tag in einer neuen Spalte die Platzzuordnung ist. - Das hat auch alles super geklappt doch jetzt mit Homeoffice hatten wir ein paar Probleme und aufwan, so dass wir jetzt eine 3 Zeile hinzugefügt haben, die deviniert ob jemand zuhause oder im Büro arbeitet. An sich klappt auch alles aber ein Problem habe ich:
Problem: Um nicht jede Schicht einzeln einzutragen, haben wir eine VBA geschrieben, wo nach vorauswahl eines Auswahlbutton die markierten Zellen ausgefüllt werden. Nur erkennt die VPA jetzt nicht das es eine zusätziche Spalte gibt und füllt daher die markierten Zellen falsch ein. Ich hoffe man versteht was ich meine. Also z.B. es wird Zeile H5 bis Q5 markiert, im Button Frühschicht MUC2 (als Platzzuordnung) ausgewählt und dan wird die Schicht "1" definiert. Jetzt Fühlt das System wie folgt aus: H5 1 I5 2 J5 1 K5 2 L5 1 M5 2 N5 1 O5 2 P5 1 Q5 2 aus. Es sollte aber so aussehen: H5 1 I5 2 J5 leer K5 1 L5 2 M5 leer N5 1 O5 2 P5 leer Q5 1 R5 2 S5 leer.
Der Quellcode sieht so aus für das alles:
Da ich das alles geschrieben habe ohne viel davon zu verstehen, kann ich jetzt die gewünschte korrektur mit der leerzeile nicht einpflegen. Ich würde es aber gern verstehen - wie ich das hinbekomm. Hat jemand von euch lust mir das zu zeigen?
Vielen Dank an euch
Public x As Integer
'Option Button beginn
Sub OptionButton1_Click() 'Schichtbutton
If OptionButton1.Value = True Then
x = 1
End If
End Sub
Sub OptionButton2_Click() 'Schichtbutton
If OptionButton2.Value = True Then
x = 2
End If
End Sub
Sub OptionButton3_Click() 'Schichtbutton
If OptionButton3.Value = True Then
x = 3
End If
End Sub
Sub OptionButton4_Click() 'Schichtbutton
If OptionButton4.Value = True Then
x = 4
End If
End Sub
Sub OptionButton5_Click() 'Schichtbutton
If OptionButton5.Value = True Then
x = 5
End If
End Sub
Sub OptionButton6_Click() 'Schichtbutton
If OptionButton6.Value = True Then
x = 10
End If
End Sub
Sub OptionButton7_Click() 'Schichtbutton
If OptionButton7.Value = True Then
x = 0
End If
End Sub
Sub OptionButton8_Click() 'Schichtbutton
If OptionButton8.Value = True Then
x = 6
End If
End Sub
Sub OptionButton9_Click() 'Schichtbutton
If OptionButton9.Value = True Then
x = 7
End If
End Sub
Sub OptionButton10_Click() 'Schichtbutton
If OptionButton10.Value = True Then
x = 8
End If
End Sub
Sub OptionButton11_Click() 'Schichtbutton
If OptionButton11.Value = True Then
x = 9
End If
End Sub
'Schicht 1 ###########
Private Sub CommandButton1_Click()
Call BereichFormatieren
End Sub
Sub BereichFormatieren()
Dim zelle As Range
Application.ScreenUpdating = False
For Each zelle In Selection.Cells
If zelle.Column Mod 2 = 0 Then
zelle.Value = 1
ElseIf x > 0 Then
zelle.Value = x
End If
Next zelle
End Sub
'Schicht 10 ####
Private Sub CommandButton10_Click()
Call BereichFormatieren10
End Sub
Sub BereichFormatieren10()
Dim zelle As Range
Application.ScreenUpdating = False
For Each zelle In Selection.Cells
If zelle.Column Mod 2 = 0 Then
zelle.Value = 10
ElseIf x > 0 Then
zelle.Value = x
End If
Next zelle
End Sub
'Schichtbutton F2
Private Sub CommandButtonF2_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "F2" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton F3
Private Sub CommandButtonF3_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "F3" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton S1
Private Sub CommandButtonS1_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "S1" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton S2
Private Sub CommandButtonS2_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "S2" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton S3
Private Sub CommandButtonS3_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "S3" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton N
Private Sub CommandButtonN_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "N" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton FL
Private Sub CommandButtonFL_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "FL" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton SL
Private Sub CommandButtonSL_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "SL" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton 3
Private Sub CommandButton3_Click()
Call BereichFormatieren3
End Sub
Sub BereichFormatieren3()
Dim zelle As Range
Application.ScreenUpdating = False
For Each zelle In Selection.Cells
If zelle.Column Mod 2 = 0 Then
zelle.Value = 3 'gewählte Schicht
ElseIf x > 0 Then
zelle.Value = x
End If
Next zelle
End Sub
'Schichtbutton
Private Sub CommandButton4_Click()
Call BereichFormatieren4
End Sub
Sub BereichFormatieren4()
Dim zelle As Range
Application.ScreenUpdating = False
For Each zelle In Selection.Cells
If zelle.Column Mod 2 = 0 Then
zelle.Value = 4
ElseIf x > 0 Then
zelle.Value = x
End If
Next zelle
End Sub
'Schichtbutton U
Private Sub CommandButtonU_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "U" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton UF
Private Sub CommandButtonUF_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "UF" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton F1
Private Sub CommandButtonF1_Click()
Dim rngBereich As Range
Set rngBereich = Range("H5:BP67") 'Hier den Bereich angeben !
If Intersect(ActiveCell, rngBereich) Is Nothing Then
MsgBox "Falscher Bereich ausgewählt", vbCritical + vbOKOnly, _
"Fehlerhafte Zelle"
Else
If Selection.Cells.Count > 1 Then Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Value = "F1" 'Hier Schichtausgabe
End If
End Sub
'Schichtbutton
Private Sub CommandButton8_Click()
Call BereichFormatieren8
End Sub
Sub BereichFormatieren8()
Dim zelle As Range
Application.ScreenUpdating = False
For Each zelle In Selection.Cells
If zelle.Column Mod 2 = 0 Then
zelle.Value = 8
ElseIf x > 0 Then
zelle.Value = x
End If
Next zelle
End Sub
'Schichtbutton
Private Sub CommandButton9_Click()
Call BereichFormatieren9
End Sub
Sub BereichFormatieren9()
Dim zelle As Range
Application.ScreenUpdating = False
For Each zelle In Selection.Cells
If zelle.Column Mod 2 = 0 Then
zelle.Value = 9
ElseIf x > 0 Then
zelle.Value = x
End If
Next zelle
End Sub
|