Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1036to1040
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
Inhaltsverzeichnis

CSV-Import

CSV-Import
12.01.2009 16:13:30
Horst
Hallo Excel-Freaks,
weiß jemand, wie man den Import von mehreren .csv's in einem Registerblatt am besten angehen könnte?
Problem: Ich habe in einem Ordner 150 .csv's, jede der .csv's stellt Werte für einen anderen Tag dar. Ich möchte nun aus diesen .csv's 1 durchgehende Liste in .xls erzeugen. Kennt jemand einen Trick, wie man mehrere .csv's gleichzeitig in ein .xls importieren kann?

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: CSV-Import
12.01.2009 18:08:00
fcs
Hallo Horst,
je nachdem wie die Daten in deinen CSV-Dateien getrennt sind funtkioniert eine der nachfolgenden Varianten. Da Excel unter VBA mit dem Import von unter Deutschen Einstellungen erstellten CSV-Dateien Probleme macht braucht man gff. die eine oder andere Variante.
Gruß
Franz

Sub CSV_Dateien_importieren()
' Daten aus CSV-Dateien einfügen, Daten sind durch Semicolon getrennt, _
Dezimalstelle ist Komma
' im aktiven Blatt werden Daten aus CSV Dateien im gewählten Verzeichnis eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant, DateinameTXT As String
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv", _
Title:="CSV-Datei im Verzeichnis auswählen")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
Set rngZelle = wksAktiv.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Dateiname = Dir(strVerzeichnis & Application.PathSeparator & "*.csv")
Application.ScreenUpdating = False
Do Until Dateiname = ""
'CSV-Datei temporär als txt-Datei kopieren
VBA.FileCopy Source:=Dateiname, Destination:=Left(Dateiname, Len(Dateiname) - 3) & "txt" _
DateinameTXT = Left(Dateiname, Len(Dateiname) - 3) & "txt"
'Umbenannte Kopie öffnen
Application.Workbooks.OpenText Filename:=DateinameTXT, Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False
Set wb = ActiveWorkbook
'Daten Kopieren
wb.Sheets(1).UsedRange.Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
'Nächste Einfügezelle setzen
Set rngZelle = rngZelle.Offset(wb.Sheets(1).UsedRange.Rows.Count, 0)
wb.Close savechanges:=False
'TXT-Kopie wieder löschen
VBA.Kill (DateinameTXT)
Dateiname = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub CSV_Dateien_importieren_2()
' Daten aus einer CSV-Datei einfügen, Daten sind durch Komma getrennt _
Dezimalstelle ist Punkt, Datum im US-Format oder internationalen Format
' im aktiven Blatt werden Daten aus CSV Dateien im gewählten Verzeichnis eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv", _
Title:="CSV-Datei im Verzeichnis auswählen")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
Set rngZelle = wksAktiv.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Dateiname = Dir(strVerzeichnis & Application.PathSeparator & "*a.csv")
Application.ScreenUpdating = False
Do Until Dateiname = ""
'CSV-Datei öffnen
Application.Workbooks.Open Filename:=Dateiname, ReadOnly:=True
Set wb = ActiveWorkbook
'Daten Kopieren
wb.Sheets(1).UsedRange.Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
'Nächste Einfügezelle setzen
Set rngZelle = rngZelle.Offset(wb.Sheets(1).UsedRange.Rows.Count, 0)
wb.Close savechanges:=False
Dateiname = Dir
Loop
Application.ScreenUpdating = True
End Sub


Anzeige
AW: CSV-Import
12.01.2009 22:25:00
Horst
Vielen Dank für den VBA-Code! Die Prozedur funktioniert ja ganz gut bei einer einzelnen .csv, das Problem ist allerdings folgendes: Der Ordner enthält zig hundert .csv's. Ziel soll es sein, dass die Werte jeder .csv der darin enthaltenen Zellen B7 bis D14 in einem Registerblatt (.xls) untereinander kopiert werden.
Übrigens verwende ich Punkt als Dezimaltrennzeichen, also "Sub CSV_Dateien_importieren_2()".
Besten Dank für weitere Vorschläge!
AW: CSV-Import
13.01.2009 09:02:00
fcs
Hallo Horst,
hier die Anpassungen, um immer einen bestimmten Zellbereich aus den CSV-Dateien zu übernehmen.
Gruß
Franz

Sub CSV_Dateien_importieren_2()
' Daten aus einer CSV-Datei einfügen, Daten sind durch Komma getrennt _
Dezimalstelle ist Punkt, Datum im US-Format oder internationalen Format
' im aktiven Blatt werden Daten aus CSV Dateien im gewählten Verzeichnis eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant
Const strBereich As String = "B7:D14" 'zu kopierender Bereich
Const lngZeilenBereich As Long = 8 'Zeilen des kopierten Bereichs in CSV-datei
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv", _
Title:="CSV-Datei im Verzeichnis auswählen")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
'1. Einfügezelle in Spalte 1 (A) ermitteln
Set rngZelle = wksAktiv.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Dateiname = Dir(strVerzeichnis & Application.PathSeparator & "*a.csv")
Application.ScreenUpdating = False
Do Until Dateiname = ""
'CSV-Datei öffnen
Application.Workbooks.Open Filename:=Dateiname, ReadOnly:=True
Set wb = ActiveWorkbook
'Daten Kopieren
wb.Sheets(1).Range(strBereich).Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
'Nächste Einfügezelle setzen
Set rngZelle = rngZelle.Offset(lngZeilenBereich, 0)
wb.Close savechanges:=False
Dateiname = Dir
Loop
Application.ScreenUpdating = True
End Sub


Anzeige
AW: CSV-Import
13.01.2009 12:08:27
Horst
Danke für die Erweiterung des VBA-Codes! Das eigentliche Problem ist damit aber noch nicht ganz gelöst. Gibt es eine Möglichkeit, dass sich sämtliche in einem Ordner befindliche .csv's in einem .xls zusammenfassen lassen? Unter folgendem Link findet sich ein Muster einer automatisiert erstellten .csv, wie ich sie bekomme. Für jeden Tag gibt es eine neue .csv mit jeweils neuen Werten. Der Aufbau der .csv ist dabei aber immer ident. Mein Ziel ist, dass sich sämtliche .csv's in einem .xls untereinanderkopieren.
https://www.herber.de/bbs/user/58334.xls
Anzeige
AW: CSV-Import
13.01.2009 13:03:26
fcs
Hallo Horst,
meine Prozedur arbeit in der Do-Loop-Schleife alle Dateien im Verzeichnis ab.
Das Problem deiner CSV-Dateien könnte aber sein:
Trennzeichen zwischen Spalten = ";"
Dezimalzeichen: "."
Diese Kombination funktioniert nicht so recht unter VBA, da standardmäßig CSV-Dateien von Excel Komma-separiert mit Punkt als Dezimalzeichen interpretiert werden.
Probiere mal nach Anpassung bzgl. Kopierbereich den anderen Code den ich gepostet hatte.
Ggf. muss man einen anderen Weg gehen für den Import der Daten, um das Problem mit dem Dezimalstellenzeichen zu lösen.
Gruß
Franz
Anzeige
AW: CSV-Import
13.01.2009 21:00:17
Horst
Hallo Franz,
ich hab' die Systemeinstellungen für das Dezimaltrennzeichen auf die deutsche Einstellung gesetzt und nochmal Variante 1 deines VBA-Codes getestet. Funktioniert perfekt!! Grundsätzlich genau das, was ich wollte. Eine Kleinigkeit wäre da noch. Ist es möglich, den Import so zu gestalten, dass von jeder .csv nur die Zellen C8 bis D14 rauskopiert werden UND stets Zelle B7 (dort steht das Datum drin) in eine Zelle links neben dem kopierten Zellinhalt der jeweiligen .csv geschrieben wird. Im Bezug auf die Musterdatei sollte das Ergebnis dann wie folgt aussehen:
https://www.herber.de/bbs/user/58356.xls
Wäre super, wenn du das hinbekommen würdest. Besten Dank schon mal im voraus!
Anzeige
AW: CSV-Import
14.01.2009 13:05:00
fcs
Hallo Horst,
hier die angepasste Prozedur.
Durch Angabe eines weiteren Parameters für den Import wird der Dezimalpunkt in den Zahlen jetzt auch erkannt, wenn die Systemeinstellungen anders (z.B Deutsch mit Komma) sind.
Gruß
Franz

Sub CSV_Dateien_importieren()
' Daten aus CSV-Dateien einfügen, Daten sind durch Semicolon getrennt, _
Dezimalstelle ist Punkt
' im aktiven Blatt werden Daten aus CSV Dateien im gewählten Verzeichnis eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant, DateinameTXT As String
Const strZelleDatum As String = "B7" 'Zelle mit Datum in CSV-Datei
Const strBereich As String = "C8:D14" 'zu kopierender Bereich in CSV-Datei
Const lngZeilenBereich As Long = 7 'Anzahl Zeilen des kopierten Bereichs in CSV-datei
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv", _
Title:="CSV-Datei im Verzeichnis auswählen")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
'Nächste freie Zelle in Spalte B (2) am Ende suchen
Set rngZelle = wksAktiv.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Dateiname = Dir(strVerzeichnis & Application.PathSeparator & "*.csv")
Application.ScreenUpdating = False
Do Until Dateiname = ""
'CSV-Datei temporär als txt-Datei kopieren
VBA.FileCopy Source:=Dateiname, Destination:=Left(Dateiname, Len(Dateiname) - 3) & "txt"
DateinameTXT = Left(Dateiname, Len(Dateiname) - 3) & "txt"
'Umbenannte Kopie öffnen
Application.Workbooks.OpenText Filename:=DateinameTXT, Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
DecimalSeparator:=".", ThousandsSeparator:=","
Set wb = ActiveWorkbook
'Daten Kopieren
wb.Sheets(1).Range(strBereich).Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
'Datum aus CSV-Datei in Spalte links von den Daten einfügen
wksAktiv.Range(rngZelle.Offset(0, -1), rngZelle.Offset(lngZeilenBereich - 1, -1)).Value _
= wb.Sheets(1).Range(strZelleDatum)
'Nächste Einfügezelle setzen
Set rngZelle = rngZelle.Offset(lngZeilenBereich, 0)
wb.Close savechanges:=False
'TXT-Kopie wieder löschen
VBA.Kill (DateinameTXT)
Dateiname = Dir
Loop
Application.ScreenUpdating = True
End Sub


Anzeige
AW: CSV-Import
14.01.2009 21:14:00
Horst
Hallo Franz!
Allerbesten Dank! Der VBA-Code läuft perfekt und funktioniert sogar (wie du bereits erwähnt hast) bei dt. Ländereinstellung und Punkt statt Komma als Dezimaltrennzeichen. Um die bei größeren .csv's auftretende Zwischenablage-Abfrage zu unterdrücken habe ich ergänzend noch ein "Application.DisplayAlerts = False" eingefügt.
Bist du öfter im Forum bzw. machst du auch Auftragsprogrammierung, falls ich mal Unterstützung für ein zeitaufwendigeres Projekt benötigen würde? Kannst du noch andere Programmiersprachen außer VBA (zB. C, C++ oder C#?)
AW: CSV-Import
15.01.2009 09:03:00
fcs
Hallo Horst,
Auftragsprogrammierung mache ich nicht.
Bei etwas umfangreicheren VBA-Projekten haben sich die unterstützten User gelegentlich mit kleinen Sachleistungen bedankt.
Erfahrungen mit anderen Programmiersprachen (Wordperfect-Makros, FORTRAN, Atari-BASIC) liegen bei mir schon Jahrzehnte zurück. MS Office VBA-Programmierung (Schwerpunkt Excel, etwas Word) ist ein Hobby von mir.
Gruß
Franz
Anzeige
AW: CSV-Import
15.01.2009 11:30:23
Horst
Hallo Franz,
Abschließend noch eine letzte Sache: Wie müsste ich den VBA-Code verändern, dass statt einem konstanten Bereich sämtliche ab einer bestimmten Zelle im .csv enthaltenen Daten (eines bestimmten Bereiches) ausgelesen werden. Beispielsweise sollen sämtliche Zellen ab und inkl. der Zelle C8 im Bereich C:F ausgelesen werden. Idealerweise solche, bei denen in der Spalte A ein "PP" steht. Dies kann je nach Größe der .csv beispielsweise für den Bereich C8:F175 bzw. für den Bereich C8:F847 gelten.
AW: CSV-Import
15.01.2009 17:24:53
fcs
Hallo Horst,
ich hab die Prozeduren jetzt so umgestrickt, dass du Varianten für den Kopiervorgang einrichten kannst.
Für den Kopiervorgang und sas Prüfen gibt es Subroutinen, deren Parameter von der Hauptroutine aus übergeben werden.
Gruß
Franz

Sub CSV_Import_Variante1()
'Daten aus Bereich C8:Fxxx importieren
Call CSV_Dateien_importieren(strZelleDatum:="B7", ZeileStart:=8, _
Spalte_1:=3, Spalte_L:=6, Spalte_Last:=3, bolPruefen:=True, _
SpaltePruefen:=1, PruefWert:="PP")
End Sub
Sub CSV_Dateien_importieren(strZelleDatum As String, ZeileStart As Long, _
Spalte_1 As Long, Spalte_L As Long, Optional Spalte_Last As Long = 1, _
Optional bolPruefen As Boolean = False, _
Optional SpaltePruefen As Long = 1, _
Optional PruefWert As Variant)
' Daten aus CSV-Dateien einfügen, Daten sind durch Semicolon getrennt, _
Dezimalstelle ist Punkt
' im aktiven Blatt werden Daten aus CSV Dateien im gewählten Verzeichnis eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant, DateinameTXT As String
Dim lngZeilenbereich As Long, ZeileLast As Long
'strZelleDatum  = Adresse der Zelle mit Datum in CSV-Datei
'ZeileStart     = Zeile ab der Daten aus CSV-Datei kopiert werden sollen
'Spalte_1       = 1. Spalte, die aus CSV-Datei kopiert werden soll
'Spalte_L       = letzte Spalte, die aus CSV-Datei kopiert werden soll
'Spalte_Last    = Spalte, in der die letzte Zeile mit Daten ermittelt werden soll
'bolPruefen     = wenn True dann werden die Werte in der Prüfspalte geprüft
'SpaltePruefen  = Nummer der Spalte, deren Werte geprüft werden solen
'PruefWert      = Wert der in der Prüfspalte übereinstimmen soll
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv", _
Title:="CSV-Datei im Verzeichnis auswählen")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
'Nächste freie Zelle in Spalte B (2) am Ende suchen
Set rngZelle = wksAktiv.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Dateiname = Dir(strVerzeichnis & Application.PathSeparator & "*.csv")
Application.ScreenUpdating = False
Do Until Dateiname = ""
'CSV-Datei temporär als txt-Datei kopieren
VBA.FileCopy Source:=Dateiname, Destination:=Left(Dateiname, Len(Dateiname) - 3) & "txt"
DateinameTXT = Left(Dateiname, Len(Dateiname) - 3) & "txt"
'Umbenannte Kopie öffnen
Application.Workbooks.OpenText Filename:=DateinameTXT, Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
DecimalSeparator:=".", ThousandsSeparator:=","
Set wb = ActiveWorkbook
Set wks = wb.Worksheets(1)
With wks
'ggf. Werte prüfen und Zeilen Löschen
If bolPruefen = True Then
Call Ceck_Spalte_Wert(wksPruef:=wks, PruefSpalte:=SpaltePruefen, Wert:=PruefWert, _
Zeile1:=ZeileStart)
End If
'Letzte Zeile mit Daten ermitteln
ZeileLast = .Cells(.Rows.Count, Spalte_Last).End(xlUp).Row
'Daten Kopieren
lngZeilenbereich = ZeileLast - ZeileStart + 1
If lngZeilenbereich > 0 Then
.Range(.Cells(ZeileStart, Spalte_1), .Cells(ZeileLast, Spalte_L)).Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
'Datum aus CSV-Datei in Spalte links von den Daten einfügen
wksAktiv.Range(rngZelle.Offset(0, -1), rngZelle.Offset(lngZeilenbereich - 1, -1)). _
Value _
= .Range(strZelleDatum)
'Nächste Einfügezelle setzen
Set rngZelle = rngZelle.Offset(lngZeilenbereich, 0)
End If
End With
Application.DisplayAlerts = False
wb.Close savechanges:=False
'TXT-Kopie wieder löschen
VBA.Kill (DateinameTXT)
Application.DisplayAlerts = True
Dateiname = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub Ceck_Spalte_Wert(wksPruef As Worksheet, PruefSpalte As Long, Wert As Variant, _
Optional Zeile1 As Long = 1)
'Im Tabellenblatt alle Zeilen Löschen, deren Zellinhalt in Prüfspalte _
verschieden von Wert ist.
'wksPruef = zu pruefendes Tabellenblatt
'PruefSpalte =Spalte deren Inhalt geprüft werden soll
'Wert = Prüfwert
'Zeile1 =Zeile ab der geprüft werden soll
Dim Zeile As Long, ZeileL As Long
With wksPruef
ZeileL = .Cells.SpecialCells(xlCellTypeLastCell).Row
For Zeile = Zeile1 To ZeileL
If Cells(Zeile, PruefSpalte).Value  Wert Then
.Rows(Zeile).ClearContents
End If
Next
.Range(.Cells(Zeile1, 1), .Cells(ZeileL, 1)).SpecialCells(xlCellTypeBlanks) _
.EntireRow.Delete Shift:=xlShiftUp
End With
End Sub


Anzeige
AW: CSV-Import
16.01.2009 22:59:00
Horst
Hallo Franz,
die Prozedur funktioniert großartig! Besten Dank für alles! Weiter so! :-))

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige