Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 12:28:32
Formelfehler aufgrund Einfügen einer Zeile
18.04.2024 11:51:04
Aus Listbox Spalte als Wert zurück bekommen
18.04.2024 11:36:51
Beim Öffnen je nach Datum zu bestimmter Zelle springen
18.04.2024 11:16:38
Pfade werden mit Anführungszeichen "" versehen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1476to1480
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

CSV-Import - nicht alle Daten werden importiert

CSV-Import - nicht alle Daten werden importiert
18.02.2016 13:49:13
Cora
Hallo liebe Forums-Mitglieder,
ich habe mit Makro-Programmierung leider quasi noch keine Erfahrung, und habe mir mit Vorlagen und Tipps&Tricks hier aus dem Forum eine Importmöglichkeit für CSV-Dateien zusammengebaut.
Leider wird hierbei nur der Inhalt der ersten 16 Zeilen meiner CSV-Datei importiert. Eine (nicht die erste) Spalte hat aber >100 Zeileneinträge.
Was muss ich ändern um alle Werte importiert zu bekommen?
Bin über Hilfe dankbar - wahrscheinlich ist es recht einfach... aber ich steh gerade auf dem Schlauch.
Danke schonmal!
VG Cora
Sub Datei_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long
'Löscht Inhalt des angegebenen Bereichs, Formatierung bleibt "Clear" statt "ClearContents" lö _
scht auch Formatierung
Range("A10:BU300").ClearContents
Const cStrDelim As String = ";" 'Trennzeichen
Const cLngFirst As Long = 10 'erste zu beschreibende Zeile
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = "N:\Starcheck\*.csv"  'Pfad anpassen
If .Show = -1 Then
strFileName = .SelectedItems(1)
End If
End With
If strFileName  "" Then
Application.ScreenUpdating = False
Open strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 0 To UBound(arrDaten) '0: startet in erster Zeile den Import
arrTmp = Split(arrDaten(lngR), cStrDelim)
If UBound(arrTmp) > -1 Then
With ActiveSheet
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '.Cells(Rows.Count, 1) macht dass  _
die Anzahl an Zeilen importiert werden, die in der ersten Spalte stehen
lngLast = Application.Max(lngLast, cLngFirst)
.Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
End With
End If
Next lngR
End If
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: CSV-Import - nicht alle Daten werden importiert
18.02.2016 14:00:06
Cora
Ich glaube, dass ich da einen Befehl drin habe, der die Anzahl der beschriebenen Zeilen der ersten Spalte ermittelt (z.B. 15), und auch im folgenden Dokument die Werte in den anderen Spalten nur bis hin zu dieser Zeile importiert.
In meiner Oirginaldatei stehen in Spalte 1 bis Zeile 19 Werte, in Spalte AO aber bis Zeile 96. Importiert wird aber alles nur bis Zeile 19...
Ich habe eine Beispiel-text-Datei hochgeladen (.csv geht nicht): https://www.herber.de/bbs/user/103682.txt

AW: CSV-Import - nicht alle Daten werden importiert
18.02.2016 16:02:50
selli
hallo cora,
mal von hinten durch die brust ins auge.
irgendwie gibt es da ein problem mit den führenden ;
da ich mich mit arrays aber nicht sonderlich gut auskenn, habe ich die teilung des ersten arrays mal gelassen und dafür die texte in spalten aufgeteilt.
vielleicht passt es ja so.
Sub Datei_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long
'Löscht Inhalt des angegebenen Bereichs, Formatierung bleibt "Clear" statt "ClearContents" lö  _
_
scht auch Formatierung
Range("A10:BU300").ClearContents
Const cStrDelim As String = ";" 'Trennzeichen
Const cLngFirst As Long = 10 'erste zu beschreibende Zeile
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = "N:\Starcheck\*.csv"  'Pfad anpassen
If .Show = -1 Then
strFileName = .SelectedItems(1)
End If
End With
If strFileName  "" Then
Application.ScreenUpdating = False
Open strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 0 To UBound(arrDaten) '0: startet in erster Zeile den Import
With ActiveSheet
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '.Cells(Rows.Count, 1) macht dass  _
die Anzahl an Zeilen importiert werden, die in der ersten Spalte stehen
lngLast = Application.Max(lngLast, cLngFirst)
.Cells(lngLast, 1) = arrDaten(lngR)
End With
Next lngR
End If
Range(Cells(cLngFirst, 1), Cells(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, 1)). _
TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
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), Array( _
13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1)), TrailingMinusNumbers _
:=True
End Sub

gruß
selli

Anzeige
kleine korrektur
18.02.2016 16:07:21
selli
hallo cora,
kleine korrektur bezüglich des "text in spalten"-ziels.
Sub Datei_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long
'Löscht Inhalt des angegebenen Bereichs, Formatierung bleibt "Clear" statt "ClearContents" lö  _
_
scht auch Formatierung
Range("A10:BU300").ClearContents
Const cStrDelim As String = ";" 'Trennzeichen
Const cLngFirst As Long = 10 'erste zu beschreibende Zeile
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = "D:\HCSRR\000\*.csv"  'Pfad anpassen
If .Show = -1 Then
strFileName = .SelectedItems(1)
End If
End With
If strFileName  "" Then
Application.ScreenUpdating = False
Open strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 0 To UBound(arrDaten) '0: startet in erster Zeile den Import
With ActiveSheet
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '.Cells(Rows.Count, 1) macht dass  _
die Anzahl an Zeilen importiert werden, die in der ersten Spalte stehen
lngLast = Application.Max(lngLast, cLngFirst)
.Cells(lngLast, 1) = arrDaten(lngR)
End With
Next lngR
End If
Range(Cells(cLngFirst, 1), Cells(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, 1)). _
TextToColumns Destination:=Cells(cLngFirst, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
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), Array( _
13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1)), TrailingMinusNumbers _
:=True
End Sub

gruß
selli

Anzeige
etwas eleganter
18.02.2016 16:49:46
selli
hallo sora,
hier wird an den anfang jeder zeile ein beliebiges (möglichst unverwechselbares) zeichen gesetzt, damit die ; nicht am anfang stehen und anschl wird es wieder entfernt.
Sub Datei_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long, zelle As Range
'Löscht Inhalt des angegebenen Bereichs, Formatierung bleibt "Clear" statt "ClearContents"  _
lö _
scht auch Formatierung
Range("A10:BU300").ClearContents
Const cStrDelim As String = ";" 'Trennzeichen
Const cLngFirst As Long = 10 'erste zu beschreibende Zeile
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = "N:\Starcheck\*.csv"  'Pfad anpassen
If .Show = -1 Then
strFileName = .SelectedItems(1)
End If
End With
If strFileName  "" Then
Application.ScreenUpdating = False
Open strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 0 To UBound(arrDaten) '0: startet in erster Zeile den Import
arrDaten(lngR) = "µ" & arrDaten(lngR)
arrTmp = Split(arrDaten(lngR), cStrDelim)
If UBound(arrTmp) > -1 Then
With ActiveSheet
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '.Cells(Rows.Count, 1) macht  _
dass  die Anzahl an Zeilen importiert werden, die in der ersten Spalte stehen
lngLast = Application.Max(lngLast, cLngFirst)
.Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) = Application.Transpose( _
Application.Transpose(arrTmp))
End With
End If
Next lngR
End If
For Each zelle In Range(Cells(cLngFirst, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
zelle = Right(zelle, Len(zelle) - 1)
Next zelle
End Sub

gruß
selli

Anzeige
AW: etwas eleganter
19.02.2016 12:09:38
Cora
Wow,
super! Ganz herzlichen Dank! Ich habe gerade mal schnell die letzte Version ausprobiert und es funktioniert 1a!!!
Jetzt werde ich mal dran machen zu verstehen warum :)

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige