PDA

Vollständige Version anzeigen : Für Profis: automatisch mehrere Leerzeilen bei veränderten Werten


psiloaktiv
06.12.2016, 16:24
Hallo an die Excel-Profis unter uns :rolleyes:

Ich habe eine riesengroße Liste, wo in Feld A immer ein bestimmter Wert ist. Ich möchte, wenn dieser Wert sich ändert, min. eine Leerzeile (noch besser sind mehrere Leerzeilen) automatisch hinzugefügt wird.

Ich habe mal im Anhang ein Bespiel hochgeladen. Wie kann ich das lösen?:eek:

Besten Dank für Eure Mühe.:mrcool:

Zusätzlich ist der Post im folgenden Forum:
http://www.clever-excel-forum.de/thread-7567.html

LG

steve1da
06.12.2016, 16:29
Hola,

verlinkst du bitte deine Beiträge in den verschiedenen Foren untereinander?
Danke.

Gruß,
steve1da

psiloaktiv
06.12.2016, 16:33
Klar, kann ich machen. Darf ich den überhaupt auf ein anderes Forum verlinken? :confused:

Sonst mache ich e immer so, dass ich sobald ich die Lösung habe, auch in den anderen Foren selber die Lösung oste für andere User.

steve1da
06.12.2016, 16:39
Hola,

darfst du. Somit kannst du verhindern dass sich verschiedene Leute um dein Problem kümmern ohne voneinander zu wissen.

Gruß,
steve1da

rastrans
06.12.2016, 16:39
Blöd ist dann, wenn sich mehrere Personen um deine Lösung kümmern und keine Ahnung haben, wie weit das andere Forum ist.
Sub LeerzeilenHinzu()
Const c_AnzahlLeerZeilen = 3
Dim lngZeile As Long, lngZeileMax As Long

lngZeileMax = Cells(Rows.Count, 1).End(xlUp).Row
lngZeile = 2
Do Until lngZeile > lngZeileMax
If Cells(lngZeile, 1).Value = Cells(lngZeile - 1, 1) Or IsEmpty(Cells(lngZeile, 1)) Or IsEmpty(Cells(lngZeile - 1, 1)) Then
lngZeile = lngZeile + 1
Else
Rows(lngZeile & ":" & lngZeile + c_AnzahlLeerZeilen - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
lngZeileMax = lngZeileMax + c_AnzahlLeerZeilen
lngZeile = lngZeile + c_AnzahlLeerZeilen + 1
End If
Loop
End Sub

psiloaktiv
06.12.2016, 16:55
Danke schon mal für Eure Unterstützung. Alles klar, ich habe das andere Forum oben jetzt verlinkt.

@rastans: Hab den Code jetzt eingefügt, sehr aber keine Veränderung. Irgendetwas mache ich wohl falsch?

rastrans
06.12.2016, 17:01
Wenn du bereits Leerzeilen hast, dann werden keine weiteren hinzugefügt. Erstelle eine Tabelle mit deinem Ist-Zustand (ohne Leerzeilen) und dann den Code ausführen! Bei mir passiert was!

psiloaktiv
06.12.2016, 17:11
Wie genau kann ich denn den Code ausführen?

psiloaktiv
07.12.2016, 07:48
Besten Dank @rastrans.

Code Funktioniert... Wie man den Code ausführt, konnte ich hier entnehmen.
https://support.office.com/de-de/article/Ausf%C3%BChren-eines-Excel-Makros-a20bf0b0-5642-4aa8-8b99-2558a6df5fe1#__toc304793164

Nun bin ich noch nicht ganz am Ende meines Zieles. Nun muss ich eine Lösung finden, dass wenn ich drucke, die jeweilige Gruppe, nicht auf 2 Seiten verteilt abgedruckt wird. Dann sollte es gleich alles auf die folgende Seite rutschen und gedruckt werden.
(Ich hoffe, ich habe mich verständlich ausgedrückt) :D
Können wir das weiter in diesem Post bearbeiten oder soll ich einen neuen Post eröffnen?

rastrans
07.12.2016, 10:13
Beim Drucken 'Blatt auf einer Seite darstellen' auswählen, oder den Druckbereich einstellen.

psiloaktiv
07.12.2016, 10:30
Beim Drucken 'Blatt auf einer Seite darstellen' auswählen, oder den Druckbereich einstellen.

Ja, das geht leider nicht so einfach, da die Liste ca. 250-300 Seitenlang ist, je nach dem.

Einzeln Druckbereiche einstellen ist keine saubere Lösung für meinen Zweck. Eine automatische Lösung wäre hier traumhaft.

rastrans
07.12.2016, 12:56
Hier noch einstellen, nach wievielen Zeilen du einen Seitenumbruch einfügen möchtestSub SeitenUmbruchEinfuegen()
Const c_UmbruchNachZeilen = 50
Dim lngZeile As Long, lngZeileMax As Long

ActiveSheet.ResetAllPageBreaks
lngZeileMax = Cells(Rows.Count, 1).End(xlUp).Row + 1
lngZeile = 1 + c_UmbruchNachZeilen
Do Until lngZeile > lngZeileMax
ActiveSheet.HPageBreaks.Add Before:=Rows(lngZeile)
lngZeile = lngZeile + c_UmbruchNachZeilen
Loop
End Sub