Hallo,
es gibt jede Menge Varianten, eine CSV einzulesen.
Bei der von Dir vorgelegten Version sollte man bei größeren Mengen die Störfaktoren abschalten. Siehe erste Version....
Auch habe ich hier mal, wie von Gast angeregt, ein neues Blatt einfügen und umbenennen lassen. Vielleicht ist Dir dieses ja lieber.
In der zweiten Varianten wird über ein Array gearbeitet, das sollte dann deutlich schneller gehen.
Bzgl.der Vermischung von Spalten kann ich keine Aussage treffen. Da müsste man schon eine Beispielmappe und eine Testdatei haben....
Leider kann man hier ja nichts hochladen.
Option Explicit
'Version 1
Private Sub CommandButtonImport_Click()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Title = "Select a CSV File"
.Filters.Add "CSV", "*.csv", 1
.AllowMultiSelect = False
Dim sFile As String
If .Show Then
sFile = .SelectedItems(1)
End If
End With
' Import CSV from FileDialog
If sFile <> "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'Neues Blatt einfügen
Sheets.Add , Sheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Replace(Mid$(sFile, InStrRev(sFile, "\") + 1), ".csv", "")
On Error GoTo 0
Open sFile For Input As #1
row_number = 1
Do Until EOF(1)
Line Input #1, LineFormFile
LineItems = Split(LineFormFile, ";")
ActiveSheet.Cells(row_number, 1).Resize(1, UBound(LineItems) + 1) = LineItems
row_number = row_number + 1
Loop
Close #1
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End If
End Sub
'Version 2
Private Sub CommandButtonImport_Click2()
Dim fd As Office.FileDialog
Dim iZeile As Long, oZiel As Range
Dim sSpArr() As String, sZlArr() As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Title = "Select a CSV File"
.Filters.Add "CSV", "*.csv", 1
.AllowMultiSelect = False
Dim sFile As String
If .Show Then
sFile = .SelectedItems(1)
End If
End With
' Import CSV from FileDialog
If sFile <> "" Then
'Neues Blatt einfügen
Sheets.Add , Sheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Replace(Mid$(sFile, InStrRev(sFile, "\") + 1), ".csv", "")
On Error GoTo 0
Set oZiel = ActiveSheet.Range("A1") 'Hier beginnt die Ausgabe
'Daten in Zeilenarray schaffen
sZlArr = Split( _
CreateObject("Scripting.FileSystemObject") _
.OpenTextFile(sFile).readall, vbCrLf)
'Daten zeilenweise ausgeben
For iZeile = 0 To UBound(sZlArr)
sSpArr = Split(sZlArr(iZeile), ";")
If UBound(sSpArr) >= 0 Then
oZiel.Offset(iZeile, 0).Resize(, UBound(sSpArr) + 1) = sSpArr
End If
Next iZeile
End If
End Sub
viele Grüße
Karl-Heinz
|