Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Leere Zeilen einfügen nach unterschiedl. Werten

Leere Zeilen einfügen nach unterschiedl. Werten
09.08.2007 18:14:00
Andreas
Hallo liebe Herber Fans,
ich habe mich bis jetzt erfolglos an einem Makro versucht, welches Folgendes ausführen soll. Nach jeder Zeile (nach jedem unterschiedlichen Wert) soll eine bestimmte Anzahl neue leere Zeilen eingefügt werden. Für dieses Beispiel: 40. Dann geht es weiter zur nächsten nichtleeren Zeile und wieder 40 Zeilen.
Diese Logik geht davon aus, daß jede Zeile unterschiedlich ist. Wenn dies nun nicht der Fall ist, dann soll das Makro eine Prüfung dergestalt vornehmen, daß es nur nach unterschiedlichen Werten Zeilen einfügt. Im beigefügten Beispiel soll hinter jeder Zeile eingefügt werden, außer bei „Test_11“ und „Test_20“. Dort erst hinter dem 3er Block gleicher Zeilen.
Ich habe ein Makro, welches auf Doppelklick 40 Zeilen einfügt und ein Makro, welches alle 2 Zeilen eine Zeile einfügt. Ich habe es aber nicht geschafft diese beiden Makros zu kombinieren um das gewünschte Ergebnis zu erzielen. Ich habe versucht, möglichst logisch vorzugehen und einzelne Komponenten zu verändern und zu beobachten, was passiert. Es war aber leider nicht von Erfolg gekrönt.
1. Makro:

Private Sub ZeilenEinfügen()
Dim i%
For i = 1 To 156
Cells(2 + i * 2, 1).EntireRow.Insert Shift:=xlDown
Next i
End Sub


2. Makro:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim zeilenanzahl As Integer
zeilenanzahl = 40 'InputBox("Wieviel Zeilen?")
Range(ActiveCell, ActiveCell.Offset((zeilenanzahl - 1), 0)).EntireRow.Insert
Cancel = True
End Sub


Vielen Dank für Eure Aufmerksamkeit und Ideen!
Grüße, Andreas Hanisch

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Leere Zeilen einfügen nach unterschiedl. Werte
09.08.2007 21:19:00
Uduuh
Hallo,
sowas mach man immer von unten.

Sub tt()
Dim lngRow As Long
For lngRow = Cells(65536, 1).End(xlUp).Row To 2 Step -1
If Cells(lngRow, 1)  Cells(lngRow - 1, 1) Then
Range(Cells(lngRow, 1), Cells(lngRow + 39, 1)).EntireRow.Insert
End If
Next
End Sub


Gruß aus’m Pott
Udo

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige