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

Jede zweite Zeile aus Wookbook A in ein anderes WB

Jede zweite Zeile aus Wookbook A in ein anderes WB
20.09.2016 10:59:42
linda
Hallo Leute!
Ich habe eine Frage, und hoffe ihr könnt mir helfen.
Und zwar habe ich zwei Workbooks A (.csv Datei mit einem Sheet "Referenz") und B (normale Excel mit mehreren Sheets). In Workbook B wird das Makro quasi gestartet werden, da mit der Excel-Tabelle gearbeitet wird.
Ich möchte jetzt aus Workbook A jede zweite Zeile in das Workbook B, Sheet "Kurve" kopieren.
Zurzeit kopiere ich alle Datensätze und lösche dann jeden Zweiten. Das dauert aber sehr sehr lange und ich habe mich gefragt, ob man auch einfach nur jede zweite Zeile aus A in B kopieren kann? Und würde das dann schneller gehen?
Hier mein derzeitiger Code:
Sub Referenzkurve_Klicken()
'Daten aus .csv kopieren und einfügen
'ACHTUNG: ggf. Pfad ändern
Workbooks.Open Filename:="Z:\Probe\Referenz.csv"
Range("A1:K1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.Close
Sheets("Kurve").Select
Range("A1").Select
ActiveSheet.Paste
'Jede zweite Zeile löschen
Dim i As Integer
For i = 3 To 5000 Step 1
Sheets("Kurve").Rows(i).Delete
Next
'Daten in Spalten separieren
Worksheets("Kurve").Activate
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
TrailingMinusNumbers:=True
End Sub
Ich wäre euch für eine Antwort sehr dankbar! Vielleicht habt ihr ja eine Idee, wie das ganze schneller gehen kann =).
Liebe Grüße
Linda

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Jede zweite Zeile aus Wookbook A in ein anderes WB
20.09.2016 12:36:36
Rudi
Hallo,
teste mal:
Sub Referenzkurve_Klicken()
'Daten aus .csv kopieren und einfügen
'ACHTUNG: ggf. Pfad ändern
Dim arrIn, arrOut(), i As Long, j As Long, n As Long
Workbooks.Open Filename:="Z:\Probe\Referenz.csv"
arrIn = Range("A1").CurrentRegion
ActiveWorkbook.Close
ReDim arrOut(1 To UBound(arrIn), 1 To 11)
For j = 1 To 12
arrOut(1, j) = arrIn(1, j)
arrOut(2, j) = arrIn(2, j)
Next
n = 2
For i = 3 To UBound(arrIn) Step 2
n = n + 1
For j = 1 To 11
arrOut(n, j) = arrIn(i, j)
Next j
Next i
With Sheets("Kurve")
.Cells(1, 1).Resize(n, 11) = arrOut
'Daten in Spalten separieren
.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
TrailingMinusNumbers:=True
End With
End Sub

Gruß
Rudi
Anzeige
Korrektur
20.09.2016 12:39:23
Rudi
Hallo,
besser so:
Sub Referenzkurve_Klicken()
'Daten aus .csv kopieren und einfügen
'ACHTUNG: ggf. Pfad ändern
Dim arrIn, arrOut(), i As Long, j As Long, n As Long
Workbooks.Open Filename:="Z:\Probe\Referenz.csv"
arrIn = Range("A1").CurrentRegion
ActiveWorkbook.Close
ReDim arrOut(1 To UBound(arrIn), 1 To UBound(arrIn, 2))
For j = 1 To UBound(arrIn, 2)
arrOut(1, j) = arrIn(1, j)
arrOut(2, j) = arrIn(2, j)
Next
n = 2
For i = 3 To UBound(arrIn) Step 2
n = n + 1
For j = 1 To UBound(arrIn, 2)
arrOut(n, j) = arrIn(i, j)
Next j
Next i
With Sheets("Kurve")
.Cells(1, 1).Resize(n, UBound(arrOut, 2)) = arrOut
'Daten in Spalten separieren
.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
TrailingMinusNumbers:=True
End With
End Sub
Gruß
Rudi
Anzeige
AW: Korrektur
20.09.2016 12:59:21
linda
Vielen lieben Dank Rudi!
Deine Lösung funktioniert super!! =)
AW: Jede zweite Zeile aus Wookbook A in ein anderes WB
20.09.2016 12:49:31
Daniel
Hi
jede zweite Zeile zu kopieren wird auch nicht viel schneller gehen, als jede zweite Zeile zu löschen.
das Problem ist, dass in beiden Fällen jede Zeile einzeln bearbeitet werden muss, und das kostet zeit.
um das ganze zu beschleunigen, sollest du so vorgehen:
1. alles in einem Schritt kopieren
2. per Formel in einer Hilfsspalte die zu löschenden Zeilen kennzeichnen, bspw die zu löschenden mit 1 und die die stehenbleiben müssen mit dem Text ""
3. die Liste nach der Hilfsspalte sortieren.
4. alle Zellen mit Zahl und der Option "ganze Zeile löschen"
das ist schneller, weil jetzt nicht jede Zeile einzeln, sondern alle Zellen gemeinsam gelöscht werden können.
der schritt 4 sieht als Code so aus:
Columns(...).SpecialCells(xlcelltypeformulas, 1).entirerow.Delete

es würde auch ohne das Sortieren funktionieren, aber das bringt in diesem Fall die Geschwindigkeit.
Ab Excel 2007 kann man auch ohne sortieren schnell löschen.
hier zu kennezichnet man in der Hilfsspalte die Zeilen die gelöscht werden sollen per formel mit 0 und die die stehen bleiben müssen mit der Zeilennummer.
In die Überschriftenzeile der Hilfsspalte schreibt man eben falls die 0 und wendet dann das Duplikate-entfernen mit der Hilfsspalte als Kriterium und der Option "keine Überschrift" an.
sieht als code so aus:
With Sheets("Kurve").Usedrange
with .columns(.Columns.count + 1)
.FormulaR1C1 = "=If(IsOdd(Row()),0,Row())"
.Cells(1, 1).value = 0
.EntireRow.Removeduplicates
.ClearContents
end with
End with
Gruß Daniel
Anzeige
AW: Jede zweite Zeile aus Wookbook A in ein anderes WB
20.09.2016 13:04:54
linda
Hallo Daniel!
Ich werde deine Lösung auch direkt mal ausprobieren. Vielen Dank für deine Hilfe und die Erklärung dazu!
Grüße
Linda

334 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige