Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Leerzeile einfügen
12.07.2022 13:15:09 CDM
NotSolved
12.07.2022 13:44:43 Gast23650
NotSolved
12.07.2022 14:12:10 Gast1466
NotSolved
12.07.2022 14:18:49 Gast53731
NotSolved

Ansicht des Beitrags:
Von:
CDM
Datum:
12.07.2022 13:15:09
Views:
1049
Rating: Antwort:
  Ja
Thema:
VBA Leerzeile einfügen

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 L5M5 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
 

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Leerzeile einfügen
12.07.2022 13:15:09 CDM
NotSolved
12.07.2022 13:44:43 Gast23650
NotSolved
12.07.2022 14:12:10 Gast1466
NotSolved
12.07.2022 14:18:49 Gast53731
NotSolved