Zeilen Abstand

Forumthread: Zeilen Abstand

Zeilen Abstand

28.08.2017 23:56:31

Guggus

Hallo Zusammen
Habe ähnliche frage schon einmal gestellt nur ist es etwas anderst aufgebaut.
Siehe Beiliegender Screenshot.
Ich habe nach jeder Referenz eine Zahl, welche mir die Anzahl Zeilen darstellt welche nach dieser Referenz in einem anderen Tabellenblatt erfolgen soll. Es können u.U. tausende Referenzen aufgeführt sein.
Brauch dies als Zwischenschritt für einen Webshop import.
Userbild

https://www.herber.de/bbs/user/115843.xlsm
Vielen lieben Dank!!!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

.xlsm bei "VBA bescheiden" widerspricht sich ...

29.08.2017 00:16:40

lupo1

... außerdem ist "Anzahl Leerzellen" nicht gut als Abstand in B:B, sondern immer "Gefüllte Zelle vor nächste gefüllte Zelle", also jeweils eine Zeile mehr.

AW: Zeilen Abstand

29.08.2017 09:44:32

Robert

Hallo Guggus,
folgendes Makro müsste die Liste wie gewünscht erstellen:

Sub ErstelleListe()
Dim rng As Range, i As Integer
i = 1
With Sheets("Tabelle1")
For Each rng In .Range("A1:A" & .Range("A1").CurrentRegion.Rows.Count)
Sheets("Tabelle2").Cells(i, 1) = rng
i = i + rng.Offset(0, 1) + 1
Next
End With
End Sub

Gruß
Robert

AW: Zeilen Abstand

29.08.2017 16:28:09

Guggus

Vielen Dank Robert.
Falls jetzt die Zahlen mit dem Abstand nicht in der Reihe daneben stehen, sondern Reiher "Q"
welche Wert muss ich ändern?
Ich habe etwas 1000 Reihen, mir fällt auf , das bei 40 Reihen derzeit, Excel cirka 1-2 Minuten benötigt, gibt es einen Optimierungstrick? :)
Vielen Dank und Grüsse
Guggus

AW: Zeilen Abstand

29.08.2017 17:28:28

Robert

Hallo,
in der Zeile

i = i + rng.Offset(0, 1) + 1

steht die 1 bei ...Offset(0,1)... für 1 Spalte neben der Zelle in Spalte A (im Code die Variable rng). Steht der Abstand in der Spalte Q muss die Zeile also wie folgt geändert werden

i = i + rng.Offset(0, 16) + 1

Gruß
Robert

Optimierung der Laufzeit...

29.08.2017 17:44:14

Michael

Hallo Guggus (und Robert),
...sollte erreicht werden können, wenn wir auf Arrays setzen.
Hier als Bsp-Mappe: https://www.herber.de/bbs/user/115866.xlsm
Hier der Code:

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim r As Range, Rmax&, a, b, i&, j&
Application.ScreenUpdating = False
With WsQ
Set r = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
With r
Rmax = .Rows.Count + _
WorksheetFunction.Sum(.Offset(, 1).Resize(.Rows.Count, 1))
End With
a = r: j = 1
ReDim b(1 To Rmax)
For i = LBound(a) To UBound(a)
b(j) = a(i, 1)
j = j + a(i, 2) + 1
Next i
End With
With WsZ
.Range(.Cells(1, 1), .Cells(UBound(b), 1)) = Application.Transpose(b)
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing
Set r = Nothing: Erase a: Erase b
End Sub

Annahme: Auslesen der Daten von Tabelle1 A1:Bx, Ausgabe auf Tabelle2 Spalte 1.
LG
Michael

AW: Optimierung der Laufzeit...

29.08.2017 23:45:33

Guggus

Genau das habe ich gesucht Michael. Herzliches Dankeschön!
Eine Frage noch, falls ich wie im nachfolgenden Beispiel die Referenz in Zeile C2 startet und die Anzahl einzufügender Zeilen in P2 startet, reicht es doch wenn ich folgendes ändere oder muss ich noch etwas beachten?
Userbild

Option Explicit
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle2")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle6")
Dim r As Range, Rmax&, a, b, i&, j&
Application.ScreenUpdating = False
With WsQ
Set r = .Range(.Cells(2, 3), .Cells(.Rows.Count, 16).End(xlUp))
With r
Rmax = .Rows.Count + _
WorksheetFunction.Sum(.Offset(, 1).Resize(.Rows.Count, 1))
End With
a = r: j = 1
ReDim b(1 To Rmax)
For i = LBound(a) To UBound(a)
b(j) = a(i, 1)
j = j + a(i, 2) + 1
Next i
End With
With WsZ
.Range(.Cells(2, 1), .Cells(UBound(b), 1)) = Application.Transpose(b) 'die erste Zahl  _
ind er Zeile bestimmt die Reihe des Resultats
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing
Set r = Nothing: Erase a: Erase b
End Sub

Es kommt immer die Fehlermeldung: "Index ausserhalb des Bereichs"
Grazie
Guggus

Für unzusammenhängende Bereiche...

30.08.2017 10:01:30

Michael

Guggus,
...ist das leider etwas komplizierter, als nur die Spalten in der Bereichs-Definition anzupassen; so wie Du getan hast, definierst Du einen Zellbereich von C2:Px, inkl. aller dazwischenliegenden Zellen. Du willst aber nur die beiden isolierten Bereiche C2:Cx, P2:Px ins Array laden. Daher:
Ergänzte Bsp-Mappe: https://www.herber.de/bbs/user/115876.xlsm
Ergänzter Code:

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim r As Range, c As Range, Rmax&, a, b, i&, j&
Application.ScreenUpdating = False
With WsQ
Set r = .Range(.Cells(2, "C"), .Cells(.Rows.Count, "C").End(xlUp))
Rmax = r.Rows.Count + _
WorksheetFunction.Sum(r.Offset(, 13).Resize(r.Rows.Count, 1))
a = r: ReDim Preserve a(1 To UBound(a), 1 To 2)
For Each c In r.Offset(, 13).Resize(r.Rows.Count, 1)
i = i + 1: a(i, 2) = c
Next c
j = 1
ReDim b(1 To Rmax)
For i = LBound(a, 1) To UBound(a, 1)
b(j) = a(i, 1)
j = j + a(i, 2) + 1
Next i
End With
With WsZ
.Range(.Cells(1, 1), .Cells(UBound(b), 1)) = Application.Transpose(b)
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing
Set r = Nothing: Set c = Nothing: Erase a: Erase b
End Sub

Passt?
LG
Michael

AW: Für unzusammenhängende Bereiche...

30.08.2017 21:41:33

Guggus

Bombastisch!! HERZLICHEN DANK

Gern, Danke für die Rückmeldung! owT

31.08.2017 07:57:02

Michael

Beliebteste Forumthreads (12 Monate)

Forumthread: Zeilen Abstand

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread