Zeilen einfügen/löschen (mit Bedingung)

Forumthread: Zeilen einfügen/löschen (mit Bedingung)

23.04.2009 17:01:21

Thorsten

Hallo!
Ich krieg's aus den verschiedenen Teilen nicht zusammen gebaut... ich kann VBA nachvollziehen, aber fast gar nicht selbst "bauen". Die Lösung hierfür hilft ca. 800 Leuten. Herzlichen Dank!
Die angehängte Beispieldatei ist wie das Original: ich habe 2 Tabellenblätter mit nummerierten Aufgaben, es gibt Spalten mit Formeln, und einfach Spalten mit Einträgen+definiertem Format (im Bsp. die Zellfarbe)
Wie man im Bsp. sieht, beziehen sich Spalten A:C in Tabelle2 auf A:C in Tabelle1, aber mit einem Zeilenunterschied von X+13.
Gesuchter Code:
1. Wenn in Tabelle1 Zeilen eingefügt werden (1 oder beliebig viele; bspw. unter "Aufgabe 10"), sollen in Tabelle2 an der richtigen Stelle (d. h. dort unter "Aufgabe 10") ebenso viele Zeilen neu eingefügt werden.
2. Die neuen Zeilen sollen die Formeln und Formate der Zeile darüber bekommen
3. Wenn in Tabelle1 Zeilen gelöscht werden, sollen ebenfalls in Tabelle2 gleich viele Zeilen an der "richtigen" Stelle gelöscht werden.
* Das Ganze sollte möglichst automatisch starten, sobald in Tabelle1 Zeilen eingefügt/gelöscht werden, ohne, dass man einen Button drücken muss oder so.
Klingt möglich! Ich danke vielmals, falls jemand mir eine Lösung schreiben kann!
T. Speil

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeilen einfügen/löschen (mit Bedingung)

23.04.2009 17:02:27

Thorsten
AW: Zeilen einfügen/löschen (mit Bedingung)

23.04.2009 20:44:40

Thorsten

AW: Zeilen einfügen/löschen (mit Bedingung)

23.04.2009 17:02:27

Thorsten

PS. na, gleich was vergessen: hier die Beispieldatei...!
https://www.herber.de/bbs/user/61377.xls

AW: Zeilen einfügen/löschen (mit Bedingung)

23.04.2009 20:44:40

Thorsten

* so, selbst gelöst (fast) - ein Kollege hat sich mit mir hingesetzt, der Erfahrung hat.
Ich hatte schon als Grundlage das Beispiel hier genommen: https://www.herber.de/bbs/user/35642.xls
daraus haben wir dann in Tabelle1 das hier gebastelt:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLastRneu As Long
Dim insFirstR, insLastR, myR, shiftR1, shiftR2 As Long
lngLastRneu = LZWeTab(Sheets("Tabelle1"))
shiftR1 = 13 'Offset für Tabelle2
shiftR2 = 20 ' Offset für Tabelle 3
Select Case lngLastRneu
Case Is > lngLastRow
MsgBox Target.Address(0, 0) & " eingefügt" & " / " & LZWeTab(Sheets("Tabelle1"))
insFirstR = CLng(Left(Target.Address(0, 0), InStr(Target.Address(0, 0), ":") - 1)) + shiftR1
insLastR = CLng(Right(Target.Address(0, 0), Len(Target.Address(0, 0)) - InStr(Target.Address( _
0, 0), ":"))) + shiftR1
Sheets("Tabelle2").Range(insFirstR & ":" & insLastR).Insert Shift:=xlDown
Sheets("Tabelle2").Range("A" & insFirstR - 1 & ":B" & insFirstR - 1).Copy
Sheets("Tabelle2").Range("A" & insFirstR & ":B" & insLastR).PasteSpecial Paste:=xlPasteAll,  _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
insFirstR = CLng(Left(Target.Address(0, 0), InStr(Target.Address(0, 0), ":") - 1)) + shiftR2
insLastR = CLng(Right(Target.Address(0, 0), Len(Target.Address(0, 0)) - InStr(Target.Address( _
0, 0), ":"))) + shiftR2
Sheets("Tabelle3").Range(insFirstR & ":" & insLastR).Insert Shift:=xlDown
Sheets("Tabelle3").Range("A" & insFirstR - 1 & ":B" & insFirstR - 1).Copy
Sheets("Tabelle3").Range("A" & insFirstR & ":B" & insLastR).PasteSpecial Paste:=xlPasteAll,  _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Case Is

Als Modul braucht man dann noch aus dem o. g. Beispiel den Code
Option Explicit
Public lngLastRow As Long
' Letzte nichtleere Zeile eines Tabellenblatts
Function LZWeTab(objSheet As Worksheet) As Long
Dim rng As Range
Set rng = objSheet.Cells.Find("*", Cells(1, 1), xlValues, , xlByRows, xlPrevious)
If rng Is Nothing Then LZWeTab = 1 Else LZWeTab = rng.Row
End Function

Die Beispieldatei mit 3 Tabellenblättern dazu konnte ich jetzt nicht hochladen (warum, weiß ich nicht), aber das funktioniert ja mit jeder Art Einträge - auf Blatt 2 und 3 werden hier die Einträge aus Spalte A und B in die neuen Zeilen reinkopiert.
Hoffe, es hilft jemandem!
Gruß, T. Speil

Zeilen einfügen/löschen (mit Bedingung)

Forumthread: Zeilen einfügen/löschen (mit Bedingung)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread