Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Zeilen mit VBA einfügen/löschen

Thema geschlossen 
Baumstrukturmodus
Zeilen mit VBA einfügen/löschen
Andyle Offline
Andreas-Le
Registriert seit: 01.07.2023
Version(en): Pro Plus 2019
#1
27.12.2023, 15:27 (Dieser Beitrag wurde zuletzt bearbeitet: 27.12.2023, 15:41 von Andyle.)
Hallo liebe Gemeinde

Ich habe eine Pivot-Tabelle mit Mitarbeiternamen (TB "Mitarbeiter" B5 + (+ = Eingaben nach unter)

Des weiternen habe ich ein TB "Dienstplan". Da stehen die Mitarbeiter als Zellenbezug aus "Mitarbeiter" in B9:B18 drin.

Nun mein Problem:

Die Mitarbeiteranzahl in TB "Mitarbeiter" lese ich mit =ANZAHL2(Tabelle240[Mitarbeiter]) aus.

Wenn ich jetzt im TB "Mitarbeiter" die Tabelle erweitere bzw. verkürze, soll sich der Mitarbeiterbereich im TB "Dienstplan" in der Zeilenanzahl
anpassen. (Zeile einfügen/löschen)
Alle Formeln/Bezüge müssen mit eingefügt werden!

Wie bekommt man sowas hin?

Danke Euch!
Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#2
27.12.2023, 17:44
Hallo

hier mal eine Demo Datei wo diese Bedingung erfüllt ist.  Bitte das Makro in einer Testdatei testen.
Ich weiss nicht ob das löschen oder einfügen dazu führen kann, das Formeln ihren Bezug verlieren??

mfg Gast 123


Angehängte Dateien
.xls   Zeile einfügen löschen.xls (Größe: 37,5 KB / Downloads: 3)
Suchen
Antworten Top
Andyle Offline
Andreas-Le
ThreadStarter

Registriert seit: 01.07.2023
Version(en): Pro Plus 2019
#3
27.12.2023, 18:02
Ich habe jetzt folgenden Code, der in den Grundzügen eigendlich dass macht, wass er soll.

Nun meine Frage, wie kann man den Code verkürzen?

Wie kann ich Ihn anpassen, dass beim ersten ausführen alle Zeilen die fehlen mit .Value aus TB "Mitarbeiter" eingefügt werden?

Code:
Sub neuerMonat()

If ActiveSheet.Name = "Dienstplan" Then

   Worksheets("Dienstplan").Copy after:=Worksheets(Worksheets.Count)

   ActiveSheet.Name = "0" & Range("K3") + 1 & "." & Range("L3")
   ActiveSheet.Range("K3").Comment.Delete
   ActiveSheet.Range("K3").AddComment Text:="Es wurden bereits Monatsblätter angelegt!" & vbLf & "Bitte hier den Wert nicht ändern!" & vbLf & "Um weitere Monatsblätter zu erstellen, öffnen Sie das Monatsplatt mit dem letzten Monat."
   ActiveSheet.Range("K3").Comment.Shape.TextFrame.AutoSize = True
   Else
   
   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)

   Worksheets(Worksheets.Count).Name = Format(DateAdd("m", 1, "01." & Worksheets(Worksheets.Count - 1).Name), "mm.yyyy")
   
   End If
   
   'Zeilen einfügen
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'Hier wir die letzte Zeile der Spalte B ermittelt
   letztezeile = letztezeile - 4
   MsgBox letztezeile
   'ActiveSheet.Range("W3") 'Anzahl der Mitarbeiter im TB "Mitarbeiter"
   
   If letztezeile < ActiveSheet.Range("W3") + 8 Then '9
   
   ActiveSheet.Range("B" & letztezeile).EntireRow.Insert
   
  Dim lngRowSource  As Long
  Dim lngRowTarget  As Long
 
  letztezeile_neu = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 4 'Hier wir die letzte Zeile der Spalte B ermittelt
  'MsgBox letztezeile_neu
 
  lngRowSource = letztezeile_neu
  lngRowTarget = letztezeile_neu - 1

  With ActiveSheet
    .Rows(lngRowSource).Cut
    .Rows(lngRowTarget).Insert Shift:=xlShiftDown
  End With
 
  ActiveSheet.Range("B" & letztezeile_neu) = Worksheets("Mitarbeiter").Range("B" & letztezeile_neu - 1).Value
   
  End If
   
   'Ende einfügen
   
   If ActiveSheet.Range("K3") = 12 Then
   ActiveSheet.Range("K3") = 1
   ActiveSheet.Range("L3") = Range("L3") + 1
   Else
   ActiveSheet.Range("K3") = Range("K3") + 1
   End If
   
   ActiveSheet.Range("C9:AG18").ClearContents
   
   Cells.EntireColumn.Hidden = False 'Blende alle Spalten ein
   
   'Spalten ausblenden
   If ActiveSheet.Range("H3") < 31 Then
   ActiveSheet.Columns("AG:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 30 Then
   ActiveSheet.Columns("AF:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 29 Then
   ActiveSheet.Columns("AE:AG").EntireColumn.Hidden = True
   End If
   'Ende Spalten ausblenden

End Sub
Suchen
Antworten Top
Andyle Offline
Andreas-Le
ThreadStarter

Registriert seit: 01.07.2023
Version(en): Pro Plus 2019
#4
27.12.2023, 19:21
Etwas mehr Ordnung
Code:
Sub neuerMonat()

  Dim lngRowSource  As Long
  Dim lngRowTarget  As Long

If ActiveSheet.Name = "Dienstplan" Then

   Worksheets("Dienstplan").Copy after:=Worksheets(Worksheets.Count)

   ActiveSheet.Name = "0" & Range("K3") + 1 & "." & Range("L3")
   ActiveSheet.Range("K3").Comment.Delete
   ActiveSheet.Range("K3").AddComment Text:="Es wurden bereits Monatsblätter angelegt!" & vbLf & "Bitte hier den Wert nicht ändern!" & vbLf & "Um weitere Monatsblätter zu erstellen, öffnen Sie das Monatsplatt mit dem letzten Monat."
   ActiveSheet.Range("K3").Comment.Shape.TextFrame.AutoSize = True
   
   Else
   
   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).Name = Format(DateAdd("m", 1, "01." & Worksheets(Worksheets.Count - 1).Name), "mm.yyyy")
   
   End If
   
   'Zeilen einfügen
   
   'Hier wir die letzte Zeile der Spalte B ermittelt
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
   ' MsgBox letztezeile                   ActiveSheet.Range("W3") 'Anzahl der Mitarbeiter im TB "Mitarbeiter"
   
   If letztezeile < ActiveSheet.Range("W3") + 8 Then '9
   
   ActiveSheet.Range("B" & letztezeile).EntireRow.Insert
   
  'Hier wir die letzte Zeile der Spalte B (Bereich Mitarbeiter)im aktiven TB ermittelt
  letztezeile_neu = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 4
  'MsgBox letztezeile_neu
 
  'Kopieren und einfügen
  lngRowSource = letztezeile_neu
  lngRowTarget = letztezeile_neu - 1

  With ActiveSheet
    .Rows(lngRowSource).Cut
    .Rows(lngRowTarget).Insert Shift:=xlShiftDown
  End With
 
  'Text aus TB "Mitarbeiter" holen
  ActiveSheet.Range("B" & letztezeile_neu) = Worksheets("Mitarbeiter").Range("B" & letztezeile_neu - 1).Value
   
  End If
   
   'Ende einfügen
   
   'Monat auf Dez prüfen und neues Jahr anfangen
   If ActiveSheet.Range("K3") = 12 Then
   ActiveSheet.Range("K3") = 1
   ActiveSheet.Range("L3") = Range("L3") + 1
   Else
   ActiveSheet.Range("K3") = Range("K3") + 1
   End If
   
   'Tabelleninhalt leeren
   ActiveSheet.Range("C9:AG18").ClearContents
   
   'Blende alle Spalten ein
   Cells.EntireColumn.Hidden = False
   
   'Spalten ausblenden
   If ActiveSheet.Range("H3") < 31 Then
   ActiveSheet.Columns("AG:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 30 Then
   ActiveSheet.Columns("AF:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 29 Then
   ActiveSheet.Columns("AE:AG").EntireColumn.Hidden = True
   End If
   'Ende Spalten ausblenden

End Sub
Suchen
Antworten Top
Andyle Offline
Andreas-Le
ThreadStarter

Registriert seit: 01.07.2023
Version(en): Pro Plus 2019
#5
27.12.2023, 23:05
(27.12.2023, 19:21)Andyle schrieb: So, jetzt habe ich es mit einer Schleife umgesetzt. (Anfängerglück!)

Soweit funzt es auch alles.

Was mir allerdings nicht logisch erscheint ist:

Wird der Code einmal ausgeführt, funzt alles super.
Er erstellt das neue TB und trägt komplett alle Mitarbeiter aus TB "Mitarbeiter" ein.

der Code wird aus dem gerade erstellten TB wieder gestartet, dann schreibt er eventuell hinzugekommene Mitarbeiter darunter,
setzt jetzt allerdings als letzte eine leere Zeile darunter, wodurch dann dass nachholen von weiteren Mitarbeitern nicht so richtig funzt.

Was hab ich da falsch?
Code:
Sub neuerMonat()

  Dim lngRowSource  As Long
  Dim lngRowTarget  As Long

If ActiveSheet.Name = "Dienstplan" Then

   Worksheets("Dienstplan").Copy after:=Worksheets(Worksheets.Count)

   ActiveSheet.Name = "0" & Range("K3") + 1 & "." & Range("L3")
   ActiveSheet.Range("K3").Comment.Delete
   ActiveSheet.Range("K3").AddComment Text:="Es wurden bereits Monatsblätter angelegt!" & vbLf & "Bitte hier den Wert nicht ändern!" & vbLf & "Um weitere Monatsblätter zu erstellen, öffnen Sie das Monatsplatt mit dem letzten Monat."
   ActiveSheet.Range("K3").Comment.Shape.TextFrame.AutoSize = True
  
   Else
  
   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).Name = Format(DateAdd("m", 1, "01." & Worksheets(Worksheets.Count - 1).Name), "mm.yyyy")
  
   End If
  
   'Hier wir die letzte Zeile der Spalte B ermittelt
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
  
  
   'Einfügen
  
   If letztezeile < ActiveSheet.Range("W3") + 8 Then
  
   '--------------------------------
   Dim r As Long
  
   bis = ActiveSheet.Range("W3") + 6
  
   For r = 9 To bis
   If letztezeile < ActiveSheet.Range("W3") + 8 Then
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
   'Zeile einfügen
   ActiveSheet.Range("B" & letztezeile).EntireRow.Insert
  
  'Hier wir die letzte Zeile der Spalte B (Bereich Mitarbeiter)im aktiven TB ermittelt
  letztezeile_neu = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 4
 
  'Kopieren und einfügen
  lngRowSource = letztezeile_neu
  lngRowTarget = letztezeile_neu - 1

  With ActiveSheet
    .Rows(lngRowSource).Cut
    .Rows(lngRowTarget).Insert Shift:=xlShiftDown
  End With
 
  'Text aus TB "Mitarbeiter" holen
  ActiveSheet.Range("B" & letztezeile_neu) = Worksheets("Mitarbeiter").Range("B" & letztezeile_neu - 1).Value
  End If
   Next r
   '--------------------------------
  
  
   End If
  
   'Ende einfügen
  
   '-------------------------------------------------------------------------------
  
   'Monat auf Dez prüfen und neues Jahr anfangen
   If ActiveSheet.Range("K3") = 12 Then
   ActiveSheet.Range("K3") = 1
   ActiveSheet.Range("L3") = Range("L3") + 1
   Else
   ActiveSheet.Range("K3") = Range("K3") + 1
   End If
  
   'Tabelleninhalt leeren
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
   ActiveSheet.Range("C9:AG" & letztezeile).ClearContents
  
   'Blende alle Spalten ein
   Cells.EntireColumn.Hidden = False
  
   'Spalten ausblenden
   If ActiveSheet.Range("H3") < 31 Then
   ActiveSheet.Columns("AG:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 30 Then
   ActiveSheet.Columns("AF:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 29 Then
   ActiveSheet.Columns("AE:AG").EntireColumn.Hidden = True
   End If
   'Ende Spalten ausblenden

End Sub
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste