Hallo,
siehe meine Diskussion mit Erich.
wirklich nur .csv:
Sub Johannes2()
Dim arrRoh, arrTmp, arrDaten(), n As Integer, i As Integer
Dim sFile As String, wksAusw As Worksheet, dblSum As Double
Const sPfad As String = "f:\Joh\"
Const sDelim As String = ";"
Application.ScreenUpdating = False
sFile = Dir(sPfad & "*.csv", vbNormal)
Do While sFile ""
If Right(sFile, 4) = ".csv" Then
If wksAusw Is Nothing Then
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("f:\joh\auswertung rohdaten.xls").Sheets(1) '("e:\rohdaten\ _
auswertung rohdaten.xls").Sheets(1)
With wksAusw
If .Cells(1, Columns.Count) "" Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
Exit Sub
End If
End With
End If
dblSum = 0
Open sPfad & sFile For Input As #1
arrRoh = Split(Input(LOF(1), 1), vbLf)
Close #1
Name sPfad & sFile As sPfad & sFile & "_x" 'als verarbeitet kennzeichnen
ReDim arrDaten(1 To 1, 1 To UBound(arrRoh))
arrDaten(1, 3) = CDbl(CDate(Split(arrRoh(5), sDelim)(1)))
arrDaten(1, 4) = CDbl(CDate(Split(arrRoh(6), sDelim)(1)))
arrDaten(1, 1) = arrDaten(1, 3) + arrDaten(1, 4)
arrDaten(1, 5) = Split(arrRoh(9), sDelim)(1)
arrDaten(1, 6) = Split(arrRoh(148), sDelim)(1)
n = 6
For i = 149 To UBound(arrRoh) - 1
arrTmp = Split(arrRoh(i), sDelim)
n = n + 1
dblSum = dblSum + arrTmp(1)
arrDaten(1, n) = arrTmp(1) * 1
Next
ReDim Preserve arrDaten(1 To 1, 1 To n)
arrDaten(1, 2) = Round(dblSum, 2)
With wksAusw
.Cells(1, 1).Resize(n) = Application.Transpose(arrDaten)
With .Cells(1, 1)
.Orientation = 90
.NumberFormat = "YYYY-MM-DD-hh-mm-ss"
.Value = .Text
End With
.Cells(2, 1).NumberFormat = "#,##0.00"
.Cells(3, 1).NumberFormat = "hh:mm:ss"
.Cells(4, 1).NumberFormat = "DD.MM.YYYY"
.Cells(7, 1).Resize(n - 6).NumberFormat = "#,##0.00"
.Columns(1).AutoFit
If .Cells(1, Columns.Count) "" Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
wksAusw.Parent.Save
Exit Sub
Else
.Columns(1).Insert
End If
End With
End If
sFile = Dir
Loop
If wksAusw Is Nothing Then
MsgBox "Keine Dateien vorhanden.", , "Gebe bekannt ..."
Else
wksAusw.Parent.Save
End If
End Sub
Gruß
Rudi