Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1204to1208
1204to1208
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

viele *.csv Dateien nacheinander öffnen

Forumthread: viele *.csv Dateien nacheinander öffnen

viele *.csv Dateien nacheinander öffnen
Johannes
Hallo zusammen,
mein Problem sind extrem viele *.csv Dateien mit den Rohwerten einer jeden einzelnen Messung (Kraft - Weg Messwerte ~ 1500 je Messung).
Mein Code ist in der Lage die Messwerte aus der offenen Datei zu holen und in einer zusammenfassenden Exceldatei einzufügen. Das Problem liegt darin, dass die *.csv Dateien im Verzeichnis c:\Rohwerte liegen und natürlich jede Datei einen anderen Namen hat.
Ich suche nun nach einer Möglichkeit dass der Code einfach die erste *.csv-Datei öffnet, das Auslesen der Daten durchzieht und die *.csv-Datei anschließend wieder schließt und sich dann die nächste nimmt, und das sooft wie es *.csv-Dateien im Verzeichnis gibt.
Leider konnte ich bisher nichts herausfinden, um das Problem zu lösen. Kann mir jemand von Euch hier weiterhelfen? Für Eure Mühe schon jetzt recht herzlichen Dank.
Gruß
Johannes
Anzeige
AW: viele *.csv Dateien nacheinander öffnen
Martin
Hallo Johannes,
klar bekommen wir das hin. Poste mal bitte deinen Code, damit alles reibungslos klappt.
Viele Grüße
Martin
AW: viele *.csv Dateien nacheinander öffnen
Rudi
Hallo,
so in der Art: 
Sub Rohdaten_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long
Const cstrDelim As String = ";" 'Trennzeichen
Const cstrPath As String = "c:\Rohdaten\"
strFileName = Dir(cstrPath & "*.csv")
Do While strFileName  ""
Application.ScreenUpdating = False
Open cstrPath & strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 1 To UBound(arrDaten)
arrTmp = Split(arrDaten(lngR), cstrDelim)
If UBound(arrTmp) > -1 Then
Sheets(1).Cells(Rows.Count, 1).End(xlUp) _
.Offset(1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
End If
Next lngR
Loop
End Sub

Gruß
Rudi
Anzeige
AW: viele *.csv Dateien nacheinander öffnen
Johannes
Hallo Rudi,
irgendwo klemmt es noch, denn Dein Code (ohne meine Einfügung) bringt lediglich eine nicht endende Eieruhr, mit meiner Zeile bleibt mein Code bei Range("B1").FormulaR1C1 = "=SUM(R[149]C:R[1148]C)"
hängen.
Könntest Du bitte nochmal drübersehen was da nicht klappt. Danke
Gruß
Johannes
Code:
Sub Rohdaten_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long
Const cstrDelim As String = ";" 'Trennzeichen
Const cstrPath As String = "E:\Rohdaten\"
strFileName = Dir(cstrPath & "*.csv")
Do While strFileName  ""
Application.ScreenUpdating = False
Open cstrPath & strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 1 To UBound(arrDaten)
arrTmp = Split(arrDaten(lngR), cstrDelim)
If UBound(arrTmp) > -1 Then
Sheets(1).Cells(Rows.Count, 1).End(xlUp) _
.Offset(1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
End If
Next lngR
'Zeile von mir eingefügt
Call Daten_Lesen
'Ende einfügen
Loop
End Sub

Sub Daten_Lesen()
Dim NAM As Variant  'Dateiname
Dim SUM As Variant  'Summe über Messwerte Kraft
Dim ZEI As Variant  'Zeit der Messung
Dim DAT As Variant  'Datum der Messung
Dim ERG As Variant  'Ergebnis der Messung
Range("B1").FormulaR1C1 = "=SUM(R[149]C:R[1148]C)"
Range("B1").NumberFormat = "#,##0"
Range("B2").FormulaR1C1 = "=TEXT(R[5]C,""JJJJ-MM-TT"")&""-""&TEXT(R[4]C,""hh-mm-ss"")"
NAM = Range("B2").Value
SUM = Range("B1").Value
ZEI = Range("B6").Value
DAT = Range("B7").Value
ERG = Range("B10").Value
ActiveWorkbook.SaveAs Filename:= _
"E:\Rohdaten\" & NAM & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Range("B149:B1286").Select
Selection.Copy
Workbooks.Open Filename:= _
"E:\Rohdaten\Auswertung Rohdaten.xls"
Windows("Auswertung Rohdaten.xls").Activate
Range("A6").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Value = NAM
Range("A2").Value = SUM
Range("A3").Value = ZEI
Range("A4").Value = DAT
Range("A5").Value = ERG
Columns("A").Select
Selection.Insert Shift:=xlToRight
Range("B3").NumberFormat = "h:mm:ss"
Range("B2").NumberFormat = "#,##0.00"
Range("B1").Select
With Selection
.Orientation = -90
.HorizontalAlignment = xlCenter
End With
Columns("B:B").EntireColumn.AutoFit
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close
Windows(NAM & ".xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

Anzeige
da hab ich doch glatt ...
Rudi
Hallo,
eine Zeile vergessen. 
Sub Rohdaten_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long
Const cstrDelim As String = ";" 'Trennzeichen
Const cstrPath As String = "E:\Rohdaten\"
strFileName = Dir(cstrPath & "*.csv")
Do While strFileName  ""
Application.ScreenUpdating = False
Open cstrPath & strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 1 To UBound(arrDaten)
arrTmp = Split(arrDaten(lngR), cstrDelim)
If UBound(arrTmp) > -1 Then
Sheets(1).Cells(Rows.Count, 1).End(xlUp) _
.Offset(1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
End If
Next lngR
strFileName = Dir
'Zeile von mir eingefügt
Call Daten_Lesen
'Ende einfügen
Loop
End Sub

Gruß
Rudi
Anzeige
AW: da hab ich doch glatt ...
Johannes
Hallo Rudi,
das klappt leider noch nicht. Frage: an der zitierten Stelle soll die *.csv geöffnet werden und in der nächsten Zeile gleich wieder geschlossen ? Müsste nicht hier mein Code dazwischen, oder habe ich da einen Denkfehler?
Open cstrPath & strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
Gruß
Johannes
Anzeige
Denkfehler
Rudi
Hallo,
ich hatte einen.
Zu meinem Code:
Der geht einfach hin ud liest die Daten aus allen .csv im Ordner und schreibt sie untereinander in eine Tabelle. Die .csv wird dabei in Excel gar nicht geöffnet. Von daher rasend schnell.
Wenn du mal eine .csv hochlädst, kann ich das auch für deine Auswertung so machen.
Gruß
Rudi
Anzeige
Thema verfehlt
Rudi
Hallo,
ich glaube, du willst das so: 
Sub Daten_Lesen()
Dim NAM As Variant  'Dateiname
Dim SUM As Variant  'Summe über Messwerte Kraft
Dim ZEI As Variant  'Zeit der Messung
Dim DAT As Variant  'Datum der Messung
Dim ERG As Variant  'Ergebnis der Messung
Dim sFile As String, wkbCSV As Workbook, wkbROH As Workbook
Const sPfad As String = "e:\rohdaten\"
sFile = Dir(sPfad & "*.csv")
If sFile  "" Then
Application.ScreenUpdating = False
Set wkbROH = Workbooks.Open("E:\Rohdaten\Auswertung Rohdaten.xls")
Do While sFile  ""
Set wkbCSV = Workbooks.Open(sPfad & sFile)
With wkbCSV.Sheets(1)
.Range("B1").FormulaR1C1 = "=SUM(R[149]C:R[1148]C)"
.Range("B1").NumberFormat = "#,##0"
.Range("B2").FormulaR1C1 = "=TEXT(R[5]C,""JJJJ-MM-TT"")&""-""&TEXT(R[4]C,""hh-mm-ss"")"
NAM = .Range("B2").Value
SUM = .Range("B1").Value
ZEI = .Range("B6").Value
DAT = .Range("B7").Value
ERG = .Range("B10").Value
.Range("B149:B1286").Copy wkbROH.Sheets(1).Range("A6")
.SaveAs Filename:=sPfad & NAM & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
.Parent.Close
End With
With wkbROH.Sheets(1)
With .Range("A1")
.Value = NAM
.Orientation = -90
.HorizontalAlignment = xlCenter
End With
.Range("A2").Value = SUM
.Range("A3").Value = ZEI
.Range("A4").Value = DAT
.Range("A5").Value = ERG
.Range("A3").NumberFormat = "h:mm:ss"
.Range("A2").NumberFormat = "#,##0.00"
.Columns(1).EntireColumn.AutoFit
.Columns(1).Insert Shift:=xlToRight
.Parent.Save
End With
Loop
wkbROH.Close True
End If
End Sub

Gruß
Rudi
Anzeige
AW: Thema verfehlt
Johannes
Hallo Rudi,
da haben sich mein Testen und Dein Posting überschnitten. Leider öffnet Dein Code die *.csv nicht so dass ich die Daten richtig vorliegen habe. Ich habe die Auswertedatei:
https://www.herber.de/bbs/user/73986.xls
mal hochgeladen und Tabellen 2 und 3 enthalten die unterschiedlich geöffneten Daten der selben *.csv. Leider lässt sich eine *.csv als Original nicht hochladen.
in Tabelle 1 die Daten so wie sie sein sollen
in Tabelle 2 die Daten der *.csv geöffnet mit code von Rudi
in Tabelle 3 die daten der *.csv mit meinem Code geöffnet
Kannst Du Dir das nochmal ansehen. Danke
Gruß
Johannes
Anzeige
.csv hochladen
Rudi
Hallo,
benenne sie in .txt um.
Gruß
Rudi
AW: .csv hochladen
Johannes
Hallo Rudi,
ich muss mich oben korrigieren:
Wenn ich die *.csv öffne indem ich
- Datei öffnen
-- alle Dateien (auswählen)
--- eine Datei markieren und OK
dann öffnet sich die Datei so wie in Tabelle 3 - alle meine Versuche sie über VBA zu öffnen bringen das gleiche Ergebnis wie bei Dir in Tabelle 2
Scheint also wohl mit dem Öffnen-Dialog zusammenzuhängen.
hier die als *.txt umgewandelte .csv
https://www.herber.de/bbs/user/73990.txt
Gruß
Johannes
Anzeige
AW: Thema verfehlt
Rudi
Hallo,
ändre mal: 
      Do While sFile  ""
Set wkbCSV = Workbooks.Open(sPfad & sFile), local:=True
With wkbCSV.Sheets(1)

Gruß
Rudi
AW: Thema verfehlt
Johannes
Hallo Rudi,
mein Excel stört sich an dem "Komma"
Set wkbCSV = Workbooks.Open(sPfad & sFile) -> , local:=True
und behauptet "Fehler beim Komiplieren. Erwartet: Anweisungsende"
Sorry
Gruß
Johannes
Anzeige
AW: Thema verfehlt
Rudi
Hallo,
sorry, gehört in die ()
Set wkbCSV = Workbooks.Open(sPfad & sFile, local:=True)
Gruß
Rudi
neuer Weg (Schnellstraße)
Rudi
Hallo,
50x deine hochgeladene Datei in weniger als 3 Sek: 
Sub Johannes()
Dim arrRoh, arrTmp, arrDaten(), n As Integer, i As Integer
Dim sFile As String, wksAusw As Worksheet, dblSum As Double
Const sPfad As String = "c:\test\Joh\"
Const sDelim As String = ";"
Application.ScreenUpdating = False
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("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
sFile = Dir(sPfad & "*.csv")
Do While sFile  ""
dblSum = 0
Open sPfad & sFile For Input As #1
arrRoh = Split(Input(LOF(1), 1), vbLf)
Close #1
ReDim arrDaten(1 To 1, 1 To UBound(arrRoh))
arrDaten(1, 3) = Format(CDate(Split(arrRoh(5), sDelim)(1)), "hh:mm:ss")
arrDaten(1, 4) = Format(CDate(Split(arrRoh(6), sDelim)(1)), "YYYY.MM.DD")
arrDaten(1, 1) = Format(CDate(arrDaten(1, 4)) + CDate(arrDaten(1, 3)), _
"YYYY-MM-DD-hh-mm-ss")
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)
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)
.Cells(1, 1).Orientation = 90
.Cells(2, 1).NumberFormat = "#,##0.00"
.Cells(7, 1).Resize(n - 6).NumberFormat = "#,##0.00"
.Columns(1).AutoFit
.Columns(1).Insert
End With
sFile = Dir
Loop
wksAusw.Parent.Save
End Sub

Gruß
Rudi
Anzeige
AW: neuer Weg (Schnellstraße)
Johannes
Hallo Rudi,
... aber leider mit "Schlaglöchern" ;-) nix für ungut
Bei mir kommt folgende Fehler:
https://www.herber.de/bbs/user/73991.xls
wobei ich den Pfad von
Const sPfad As String = "c:\test\Joh\"
in
Const sPfad As String = "e:\rohdaten\"
geändert hatte. Leider aber das gleiche Ergebnis.
Gruß
Johannes
Anzeige
Schlagloch
Rudi
Hallo,
kann ich nicht nachvollziehen.
2000 hab ich leider nicht, aber unter XP und 2007 läuft's mit der Datei.
Ist die Original, nur umbenannt?
Gruß
Rudi
AW: Schlagloch
Johannes
Guten Morgen Rudi,
ja die Datei wurde einfach nur umbenannt.
Gruß
Johannes
Schlaglöcher repariert?
Erich
Hi Johannes,
probier mal diese Version: 

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 = "c:\test\Joh\"
Const sDelim As String = ";"
'  Application.ScreenUpdating = False ' ist m.E. überflüssig
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("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
sFile = Dir(sPfad & "*.csv")
Do While sFile  ""
dblSum = 0
Open sPfad & sFile For Input As #1
arrRoh = Split(Input(LOF(1), 1), vbLf)
Close #1
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) = Format(CDate(arrDaten(1, 4)) + CDate(arrDaten(1, 3)), _
"YYYY-MM-DD-hh-mm-ss")
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) = 1 * arrTmp(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)
.Cells(1, 1).Orientation = 90
.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
.Columns(1).Insert
End With
sFile = Dir
Loop
wksAusw.Parent.Save
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Schlaglöcher repariert? leider nein
Johannes
Hallo Erich,
der Code hängt in der Zeile:
arrDaten(1, 1) = Format(CDate(arrDaten(1, 4)) + CDate(arrDaten(1, 3)), _
mit Fehlermeldung:
"Falsche Anzahl an Argumenten oder ungültige Zuweisung einer Eigenschaft"
das Wort "Format" ist blau unterlegt.
Ich hoffe Dir sagt das was - mir leider nicht.
Gruß
Johannes
Anzeige
jetzt vielleicht?
Erich
Hi Johannes,
dann ersetze bitte diese Zeile durch 

arrDaten(1, 1) = Format(arrDaten(1, 4) + arrDaten(1, 3), _
"YYYY-MM-DD-hh-mm-ss")
Was soll eigentlich in A1 nachher stehen?
Datum und Uhrzeit als Zahl im Format JJJJ-MM-TT-hh-mm-ss oder ein Text, der so ähnlich aussieht?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: jetzt vielleicht?
Johannes
Hallo Erich,
ich habe die betreffende Zeile einfach mal auskommentiert. Dann läuft der Code und zwar rasend schnell. Allerdings erkennt er nicht, wenn die Auswertedatei voll ist, sondern bringt dann die Fehlermeldung
"Microsoft Excel kann ausgefüllte Zellen nicht über das Blatt hinaus verschieben ...."
Der Code steht dann in Zeile .Columns(1).Insert
Das ist aktuell zwar ein Schönheitsfehler, aber nicht wirklich tragisch. Ich werde halt sehen, dass eben nicht mehr Dateien im Verzeichnis sind, als die Auswertedatei Spalten hat ;-) .
Zum Inhalt der Zelle A1 hatte ich mir gedacht, dass ich aus dem Datensatz der Datum und Uhrzeit der Messung enthält in einer Zelle diese Daten verknüpfe um dann diese Information als Suchkriterium zu nutzen um genau diese Kurve genauer ansehen zu können.
Die Messwerte stammen aus einer Servomotorischen Fügevorrichtung, die den Weg und die Kraft an den 1000 Messpunkten mitschreibt. Ziel ist es auffällige Teile und deren Kraft-Weg-Kurven zu erkennen und der Steuerung ein oder mehrere Fenster in der Kurve zu definieren die nicht durchlaufen werden dürfen - und wenn doch, dann ist der Fügevorgang fehlerhaft.
Bis dahin werden die Teile schön sortiert abgelegt und begutachtet und wenn eines auffällig ist die Kurves dieses Teils dann im Vergleich zu der Masse der anderen verglichen um "hoffentlich" eine Systematik ableiten zu können.
Gruß
Johannes
Anzeige
neuer Reparaturversuch
Rudi
Hallo,
anscheinend hat XL2000 Probs mit der Format-Funktion
Evtl. so: 
Sub Johannes()
Dim arrRoh, arrTmp, arrDaten(), n As Integer, i As Integer
Dim sFile As String, wksAusw As Worksheet, dblSum As Double
Const sPfad As String = "c:\test\Joh\"
Const sDelim As String = ";"
Application.ScreenUpdating = False
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("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
sFile = Dir(sPfad & "*.csv")
Do While sFile  ""
dblSum = 0
Open sPfad & sFile For Input As #1
arrRoh = Split(Input(LOF(1), 1), vbLf)
Close #1
ReDim arrDaten(1 To 1, 1 To UBound(arrRoh))
arrDaten(1, 3) = Format(CDate(Split(arrRoh(5), sDelim)(1)), "hh:mm:ss")
arrDaten(1, 4) = Format(CDate(Split(arrRoh(6), sDelim)(1)), "YYYY.MM.DD")
arrDaten(1, 1) = CDate(arrDaten(1, 4)) + CDate(arrDaten(1, 3))
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)
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(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
sFile = Dir
Loop
wksAusw.Parent.Save
End Sub

Gruß
Rudi
Anzeige
Ihr habt es geschafft !
Johannes
Hallo Rudi,
mein Excel verhält sich schon komisch, mit Deinem Code kommt es bei den auskommentierten Zeile zu Störungen, wenn ich jedoch diese beiden Zeile durch die alten ersetze läft der Code - auch die "Vollmeldung" kommt.
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, 3) = Format(CDate(Split(arrRoh(5), sDelim)(1)), "hh:mm:ss")
'arrDaten(1, 4) = Format(CDate(Split(arrRoh(6), sDelim)(1)), "YYYY.MM.DD") arrDaten(1, 1) = CDate(arrDaten(1, 4)) + CDate(arrDaten(1, 3))
arrDaten(1, 5) = Split(arrRoh(9), sDelim)(1)
arrDaten(1, 6) = Split(arrRoh(148), sDelim)(1)
Das die Zellen mit Datum und Zeit noch im Zahlenformat stehen ist aber nicht wirklich tragisch, das sind nur wenige Handgriffe an der gefüllten Datei um die beiden Zeilen zu formatieren.
Das im Code noch zu korrigieren ist "nur noch sportlicher Ehrgeiz" es doch noch zu schaffen - ich würde verstehen, wenn das reizt - es ist aber nicht wirklich erforderlich.
Ich möchte mich ganz herzlich für Deine und Erichs Hilfe bedanken - das hätte ich alleine nie hinbekommen.
Gruß
Johannes
Anzeige
Final Code
Rudi
Hallo,
Zeit- und Datumsformat wird gesetzt.
Zusätzlich werden die verarbeiteten Dateien mit _x gekennzeichnet. 
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
'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
sFile = Dir(sPfad & "*.csv")
Do While sFile  ""
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)
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
sFile = Dir
Loop
wksAusw.Parent.Save
End Sub

Gruß
Rudi
Anzeige
kleine Unterschiede
Erich
Hi Rudi,
unsere beiden Versionen unterscheiden sich an wenigen Stellen:
In A1 schreibt dein Code letztlich einen Text (mit .Value = .Text).
Danach ist das Format der Zelle ziemlich gleichgülltig.
Mein Code schreibt einen Zahlwert für Datum und Uhrzeit in A1 und formatiert als Datum/Uhrzeit.
In A7:A1006 schreibt dein Code Texte (arrTmp(1) ist ein String),
meine Version schreibt Zahlen (1 * arrTmp(1)).
Ist es wirklich nötig, am Anfang und am Ende zu prüfen, ob .Cells(1, Columns.Count) leer ist?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
.Cells(1, Columns.Count) prüfen
Rudi
Hallo,
ich denke schon. Sonst hakt es bei .Columns(1).Insert 
In A7:A1006 schreibt dein Code Texte (arrTmp(1) ist ein String),

stimmt, wird aber anscheinend durch Excel korrigiert. Bei echten Texten würde
.Cells(7, 1).Resize(n - 6).NumberFormat = "#,##0.00"
nicht wirken. Tut es aber. arrTmp(1) mit 1 zu multiplizieren ist aber sicherer.
Gruß
Rudi
Anzeige
Zahlformat für Text-Werte?
Erich
Hi Rudi,
"wird aber anscheinend durch Excel korrigiert.
Bei echten Texten würde .Cells(7, 1).Resize(n - 6).NumberFormat = "#,##0.00"
nicht wirken. Tut es aber."
Das glaube ich nicht, das scheint nur so. arrTmp(1) ist ein echter Text.
Probier doch mal, diese Texte als Prozente oder wissenschaftlich zu formatieren.
Das klappt nur, wenn es keine Texte, sondern Zahlen sind, also z. B. = 1 * arrTmp(1).
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
als % formatiert
Rudi
Hallo Erich,
kein Problem. Klappt
Gruß
Rudi
Danke, jetzt ist es perfekt !!
Johannes
Hallo Rudi,
das war jetzt noch das Sahnehäubchen oben auf.
Vielen, vielen Dank
Gruß
Johannes
Perfekt ist anders
Rudi
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
Anzeige
Geschafft? mal sehen...
Erich
Hi Johannes,
tut es dieser Code? 

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 = "c:\test\Joh\"
Const sDelim As String = ";"
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("e:\rohdaten\auswertung rohdaten.xls").Sheets(1)
With wksAusw
If Not IsEmpty(.Cells(1, Columns.Count)) Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
Exit Sub
End If
End With
sFile = Dir(sPfad & "*.csv")
Do While sFile  ""
dblSum = 0
Open sPfad & sFile For Input As #1
arrRoh = Split(Input(LOF(1), 1), vbLf)
Close #1
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, 4) + arrDaten(1, 3)
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) = 1 * arrTmp(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 = "DD.MM.YYYY hh:mm:ss"
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
.Columns(1).Insert
End With
sFile = Dir
Loop
wksAusw.Parent.Save
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Hast du ne Ahnung ...
Rudi
Hallo Erich,
... warum sFile = Dir(sPfad & "*.csv") auch Files, die auf .csv_x enden auswirft?
sFile= "Joh.csv_x"
Gruß
Rudi
Überhaupt keine!
Erich
Hi Rudi,
ich habe durch deinen Post gerade erst festgestellt, dass mein Textfile inzwischen 73990.csv_x_x heißt,
und die Routinen verarbeiten es weiter.
Ich bin einfach nur verblüfft, dachte, wenigstens den Befehl "Dir()" einigermaßen zu kennen :-(
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Wenn man ...
Rudi
Hallo,
... anstatt _ . nimmt, klappt es.
Name sPfad & sFile As sPfad & sFile & ".x"
Anscheinend wird der letzte . im Dateinamen genommen und nur bis zu Länge des Suchkriteriums verglichen.
sfile = Dir("c:\test\*.jpg") bringt auch Bild1.jpgabcde, Bild2.jpg123 etc. aber nicht Bild3.jpg.xxx
Gruß
Rudi
Anzeige
;

Forumthreads zu verwandten Themen

Tabellenblatt separat speichern als csv
Herbert

Hallo,
der beigefügte Code wurde mir freundlicherweise hier bereit gestellt. Aus einer Datei wird ein Tabellenblatt in eine neue Datei im Ordner C:\temp gespeichert. Das Dateiformat der neuen Datei ist csv. Die einzelnen Werte der neuen csv-Datei werden durch Semikolon getrennt. Ich benötig...
16.10.2008 16:07:00
Thread-ID: 1016905
6 Beiträge
VBA ExcelDateinamen und Arbeitsblattnamen einlesen
MarkusL

Hallo,
gibt es per VBA eine Möglichkeit alle Excel Dateien eines Verzeichnisses inkl. der jeweils enthaltenen Arbeitsblattnamen einzulesen (der Name der Exceldatei sollte ohne .xls ausgegeben werden), so dass nachfolgendes Ergebnis erzeugt wird:
Dateiname.......Arbeitsblattname
Date...
16.11.2008 15:07:00
Thread-ID: 1024906
5 Beiträge
CSV Datei abspeichern ohne diese auch zu öffnen
Stefan

Hallo,
ich arbeite an einer xls Datei, benötige aber für die Anwendung eine CSV Datei.
Wie kann ich denn eine CSV Datei abspeichern, ohne dass ich die XLS danach wieder öffnen muss? Denn ich habe danach immer die CSV offen.
Grüße udn Danke
10.10.2009 11:48:31
Thread-ID: 1108714
5 Beiträge
Anzeige
VBA Datei speichern gleich wieder öffnen
Timonski

Servus
ich habe eine Exceldatei mit viel VBA und bei einem Tabellenblatt wird die Datei sehr langsam,
dann speicher ich und lad sie gleich wieder...
und diesen Befehl würde ich gern als Icon in der Symbolleiste hinterlegen...
hätte mir da einer einen Vorschlag?
vielen Dank
21.10.2009 09:36:11
Thread-ID: 1110986
4 Beiträge
Mit VBA Datei auf Server öffnen
egon.kernien@online.de

Hallo Experten!
Ich lasse mit diesem Code eine Exceldatei pda.xls die auf einem Server liegt so öffnen, Daten aus einer Tabelle lesen-kopieren, schliessen.:
ChDir Pfad
strFile = Application.GetOpenFilename
If strFile = "Falsch" Then Exit Sub
Set wbSource = Workbooks.Open(Fi...
03.12.2009 11:32:17
Thread-ID: 1121538
3 Beiträge
VBA Probelm bei Datei einlesen und kopieren
Roland

Moin,
ich ahbe mal wieder ein VBA Problem.
Ich möchte eine Datei öffnen, die Daten daraus in eine andere Datei(Tabellenblatt) kopieren.
Jetzt meldet Excel mir:
Laufzeitfelher '1004': Für diese Aktion müssen alle verbundene Zellen dieselbe Grö0ße haben.
War eigentlich der Mei...
02.02.2010 10:57:34
Thread-ID: 1134995
2 Beiträge
csv Datei in bestimmten Pfad öffnen
Jürgen

Hallo Excel-Forum,
habe eine höchstwahrscheinlich (hoffentlich) einfache Frage. Bei der Recherche bicn ich irgendwie nicht zu einem Ergebnis gekommen.
Ich möchte per Makro eine csv.Datei öffnen. Diese liegt auf einem bestimmten Pfad (auf einem Server).
Das Excel mir im Öffnen-Dialog...
12.03.2010 12:26:48
Thread-ID: 1145363
10 Beiträge
csv - Datei einlesen
Karen

Hallo Forum,
ich möchte gerne in eine Excel Datei Daten per VBA Copy & Paste aus einer *csv Datei einlesen. Leider wandelt er die Zahlen in einen geschriebenen Test um.
Hat jemand einen Tip für mich, wie die Zahlen korrekt eingelesen werden?
Grüße
Karen
23.03.2010 09:02:24
Thread-ID: 1147748
6 Beiträge
Anzeige
CSV-Dateien einlesen
KLE

Hallo,
...ich habe ca. 200 csv-Dateien erhalten mit Daten, welche in 3-5 Spalten aufgebaut sind, welche nur mit einem KOMMA getrennt sind. Sie liegen alle in einem Verzeichnis.
Ich versuche nun schon seit gestern diese per Marko alle einzulesen, aber irgendwie klappt es nicht. Kann mir...
27.09.2010 12:02:20
Thread-ID: 1179536
4 Beiträge
Anzeige
csv - Datei öffnen / einlesen
Karen

Hallo Forum,
ich habe eine CSV Datei, die ich gerne einlesen möchte. Gibt es einen Trick, daß er die Werte nicht als Text darstellt?
Vielen Dank für die Unterstützung.
Grüße
Karen
12.10.2010 08:57:36
Thread-ID: 1181838
4 Beiträge
vba Datei öffnen, Erweiterung unbekannt
Daniel

Hallo VBA - Experten,
Wie öffne ich in vba eine Exceldatei, ohne dass ich die Dateierweiterung kenne? Mein Problem: ich habe ein Makro erhalten, welches Dateien im Excel 2003 - Format öffnet. Das Öffnen sollte auch funktionieren, wenn die Dateien in einem neueren Format mit anderer Erweiter...
09.04.2011 16:16:22
Thread-ID: 1209733
4 Beiträge
Öffnen einer Datei per VBA
Christian

Hallo Forum,
ich möchte per VBA eine Datei öffnem, deren Pfad und Namen als Text in einer Zelle steht.
in A1 steht "D:\test.xls"
dann will ich im Macro den Befehl:
Datei$ = Cells(1, 1).Select
verwenden, um den Namen in der Variablen Datei$ zu speichern.
Das geht nicht....
18.08.2011 12:48:10
Thread-ID: 1226611
4 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige