mit Satzüberleser
15.08.2013 11:52:05
Erich
Hi,
oft ist es die größte Herausforderung beim Programmieren, herauszubekommen, was das Programm leisten soll.
Jetzt wird mir klar, welche Schleife du "abbrechen und neu laufen lassen" wolltest.
Genauer willst du eigentlich nur bestimmte Datensätze überlesen.
Mit der Dateiprüfung (anhand "SpalteA" bzw. "Punktkennung") hat das rein gar nichts zu tun.
Schau dir das mal an:
Option Explicit ' immer zu empfehlen
Sub CSVImport() 'CSV-Import
Dim strSrcFile$, strTmp$, strDelimit$, suche As String
Dim intFile As Integer, arrSrc, lngLast As Long
Dim bolFileOK As Boolean, arrUeb, nn As Integer ' #####
strDelimit = ";"
suche = "SpalteA" ' "Punktkennung" ' Suche
arrUeb = Array("O", "M", "X") ' Ueberlesen ' #####
Do Until bolFileOK ' Schleife, bis OK oder Ende
' Öffnen-Dialog
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = ""
.Filters.Add "CSV-Dateien", "*.csv", 1
.Filters.Add "Alle Dateien", "*.*", 2
strSrcFile = ""
If .Show Then strSrcFile = .SelectedItems(1)
End With
If strSrcFile = "" Then Exit Sub
intFile = FreeFile
Open strSrcFile For Input As #intFile ' 1. Datenzeile
Line Input #intFile, strTmp
arrSrc = Split(strTmp, strDelimit, -1, vbTextCompare)
If arrSrc(0) = suche Then
bolFileOK = True
Else 'Suchbegriff nicht gefunden!
Close #intFile ' CSV schließen
MsgBox "Falsche CSV-Datei ausgewählt", _
vbCritical + vbOKOnly, "Abbruch!"
End If
Loop
With ThisWorkbook.ActiveSheet ' Ausgabeblatt
.Columns("A:H").NumberFormat = "@" ' (Text)
.Columns(4).NumberFormat = "0.000000000000000000"
' oder Standard, wie gewünscht?
.Columns(7).NumberFormatLocal = "Standard"
lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
lngLast = Application.Max(lngLast, 9) 'lngLast = Zeilenzähler
Do While Not EOF(intFile) ' Datenimport
Line Input #intFile, strTmp
arrSrc = Split(strTmp, strDelimit, -1, vbTextCompare)
If IsError(Application.Match(arrSrc(1), arrUeb, 0)) Then ' #####
lngLast = lngLast + 1
'ExcelSpalte = CSVSpalte
.Cells(lngLast, 1) = arrSrc(0)
.Cells(lngLast, 2) = arrSrc(1)
.Cells(lngLast, 3) = arrSrc(2)
If arrSrc(3) > "" Then .Cells(lngLast, 4) = CDbl(arrSrc(3))
.Cells(lngLast, 5) = arrSrc(4)
.Cells(lngLast, 6) = arrSrc(5)
If arrSrc(6) > "" Then .Cells(lngLast, 7) = CDbl(arrSrc(6))
.Cells(lngLast, 8) = arrSrc(7)
.Cells(lngLast, 9) = arrSrc(8)
.Cells(lngLast, 10) = arrSrc(9)
.Cells(lngLast, 12) = Now
.Cells(lngLast, 13) = Mid(strSrcFile, InStrRev(strSrcFile, "\") + 1)
.Cells(lngLast, 15).FormulaR1C1 = "=COUNTIF(C1,RC[-14])"
End If ' #####
Loop
.Columns.AutoFit
Close #intFile ' CSV schließen
End With
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich