Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1068to1072
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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

Zeilen einfügen/löschen (mit Bedingung)
23.04.2009 15: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
Anzeige
AW: Zeilen einfügen/löschen (mit Bedingung)
23.04.2009 18: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

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige