AW: Daten aus CSV-Dateien einlesen
23.01.2007 13:44:16
haw
Hallo Pattes,
ohne genaue Kenntnisse der Situation ist es fast unmöglich eine genaue Lösung zu liefern.
Eine CSV-Datei (CommaSeparatedValue) ist eine Textdatei, d.h. sie hat keine Zellen. Dass "alles in eine Zelle" eingelesen wird, ist eigentlich ein Excel-Bug.
Man kann die csv-Datei in eine txt-Datei umbennen und als Text einlesen, dann hat man wieder alles in einzelnen Zellen, wie aus Excel gewohnt.
Dass sich in der csv-Datei Zeilen mit lauter Semikola befinden, hat seine Ursache in der nicht ganz korrekten Speicherung einer Exceltabelle als csv-Datei. Es hat seine Ursache darin, dass an und für sich leere Zeilen mitgespeichert werden.
Ich habe hier ein paar Sachen geändert:
Datei wird in txt kopiert, eingelesen und dann wieder gelöscht
Zieltabelle wird immer überschrieben
Nur der benutzte Bereich der Auswertungsdatei wird eingelesen
Die alten Codezeilen habe ich auskommentiert
Sub QuartaleEinlesen()
Dim wb As Workbook, ws As Worksheet, wsQ As Worksheet
Dim i%, Nr$, efz%, lz%, AuswDatei1$, AuswDatei2$
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = ThisWorkbook.Path & "\"
.FileType = msoFileTypeAllFiles
.Filename = "Auswertung*.csv"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Application.StatusBar = Dir(.FoundFiles(i)) & " wird eingelsen ..."
Nr = Mid(Dir(.FoundFiles(i)), 11, 1)
Set wsQ = ThisWorkbook.Worksheets(Nr & ". Quartal")
' MsgBox wsQ.Name
' efz = wsQ.Cells(Rows.Count, 1).End(xlUp).Row + 1
efz = 1
AuswDatei1 = .FoundFiles(i)
AuswDatei2 = Replace(AuswDatei1, "csv", "txt")
FileCopy AuswDatei1, AuswDatei2
' Set wb = Workbooks.OpenText(Filename:=AuswDatei2)
Set wb = Workbooks.OpenText(Filename:=AuswDatei2, Origin _
:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True)
Set ws = wb.Worksheets(1)
lz = ws.Cells(Rows.Count, 1).End(xlUp).Row
wsQ.Cells.ClearContents
' ws.Range("A1:EZ80").Copy wsQ.Cells(efz, 1)
ws.UsedRange.Copy wsQ.Cells(efz, 1)
wb.Close False
Kill AuswDatei2
Next i
End If
End With
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Gruß Heinz