Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Löschen jeder 2. Zeile rausnehmen aus Code

Löschen jeder 2. Zeile rausnehmen aus Code
18.10.2016 13:18:27
Linda
Hallo ihr Lieben, hallo Rudi,
Rudi hatte mir am 20.09. bereits geholfen einen Teil des nachfolgenden Codes zusammenzustellen. Dieser bewirkt, dass nur jede zweite Zeile einer .CSV-Datei in
eine Excel-Tabelle (Sheet "KurveA") importiert wird. Jetzt ist es jedoch so, dass ich das Löschen der zweiten Zeile rückgängig machen muss, d.h. es sollen einfach alle Zeilen der .CSV-Datei übertragen werden. Jedoch kann ich das im Code nicht ändern, weil ich nicht weiß wie. Ich habe schon einiges probiert, kam aber nie zum Ziel. Könnt ihr mir bitte weiterhelfen?
Vielen lieben Dank!
Sub Kurve_einfuegen()
'Daten aus .csv kopieren und einfügen
Dim ImportDatei As Variant
Dim WBImport As Workbook
ImportDatei = Application.GetOpenFilename(Filefilter:="CSV Files (*.csv),*.csv,XLS Files (*.xls) _
,*.xls", Title:="Bitte eine CSV- oder XLS-Datei auswählen, um die KurveA einzufügen")
If ImportDatei = False Then Exit Sub
Set WBImport = Workbooks.Open(ImportDatei)
Dim arrIn, arrOut(), i As Long, j As Long, n As Long
arrIn = Range("A1").CurrentRegion
WBImport.Close savechanges:=False
'Jede zweite Zeile löschen
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 = 1
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("KurveA")
.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
With Sheets("Auswertung")
.Range("L16") = Dir(ImportDatei)
End With
Set WBImport = Nothing
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Löschen jeder 2. Zeile rausnehmen aus Code
18.10.2016 17:09:21
Bastian
Hey Linda
Ist zwar nicht richtig aber es Reicht wenn du
Step 2
Löscht
Gruß Basti
AW: Löschen jeder 2. Zeile rausnehmen aus Code
18.10.2016 17:19:27
Daniel
Fast.
es reicht im Prinzip, wenn man aus
.Cells(1, 1).Resize(n, UBound(arrOut, 2)) = arrOut
das macht:
.Cells(1, 1).Resize(n, UBound(arrOut, 2)) = arrIn
dieser Codeteil kann dann gelöscht werden:
'Jede zweite Zeile löschen
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 = 1
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
Gruß Daniel
Anzeige
AW: Löschen jeder 2. Zeile rausnehmen aus Code
18.10.2016 17:19:28
Bastian
Oder So ohne Schleifen =)
Gruß Basti
Sub Kurve_einfuegen()
'Daten aus .csv kopieren und einfügen
Dim ImportDatei As Variant
Dim WBImport As Workbook
ImportDatei = Application.GetOpenFilename(Filefilter:="CSV Files (*.csv),*.csv,XLS Files (*.xls) _
,*.xls", Title:="Bitte eine CSV- oder XLS-Datei auswählen, um die KurveA einzufügen")
If ImportDatei = False Then Exit Sub
Set WBImport = Workbooks.Open(ImportDatei)
Dim arrIn, arrOut(), i As Long, j As Long, n As Long
arrIn = Range("A1").CurrentRegion
WBImport.Close savechanges:=False
With Sheets("KurveA")
.Cells(1, 1).Resize(UBound(arrIn), UBound(arrIn, 2)) = arrIn
'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
With Sheets("Auswertung")
.Range("L16") = Dir(ImportDatei)
End With
Set WBImport = Nothing
End Sub

Anzeige
AW: Löschen jeder 2. Zeile rausnehmen aus Code
19.10.2016 09:30:31
Linda
Hallo Basti, hallo Daniel,
vielen Dank für eure Hilfe. Ich habe am Anfang probiert Step 2 in Step 1 umzuwandeln, weil ich dachte, dann wird alles geprüft und jede Zeile mitgenommen. Das hatte aber nicht funktioniert =D.
Ich danke euch, jetzt klappt alles wieder!
Liebe Grüße
Linda

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige