Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1224to1228
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten aus *.csv extrahieren

Daten aus *.csv extrahieren
Johannes
Hallo Zusammen,
mit Hilfe aus dem Forum wurde der Code erarbeitet:
Sub Daten_holen()
Dim arrRoh, arrTmp, arrDaten(), n As Integer, i As Integer
Dim sFile As String, wksAusw As Worksheet, dblSum As Double
Const sPfad As String = "e:\rohdaten\"
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
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

Das klappt auch wunderbar, jedoch reichen mittlerweile die Werte aus folgende 4 Zellen der jeweiligen *.csv B6, B7, B98 und C98 - diese hätte ich gerne wie im Beispiel https://www.herber.de/bbs/user/75971.xls
in Zeilen. Da eine *. CSV nicht hochgeladen werden kann, habe ich die Werte einer CSV hochgeladen. Das Tabellenblatt hat den Namen der *.csv. In der Tabelle 1 steht dann das Wunschergebnis. Mit 65.000 Zeilen ist eine Tabelle hinreichend groß um alle Werte der *.csv aufnehmen zu können.
Nun mein Problem: ich bekomme das nicht hin und bitte um Eure Hilfe.
Schon jetzt recht herzlichen Dank für Eure Mühe.
Gruß
Johannes

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
CSV hochladen
01.08.2011 16:31:22
Rudi
Hallo,
pack sie in ein Zip-Archiv oder benenne sie einfach (mit Hinweis) in .txt um.
Gruß
Rudi
AW: CSV hochladen
01.08.2011 23:17:35
fcs
Hallo Johannes,
mit den folgenden Anpassungen werden nur die 4 relevanten Daten aus der CSV-Datei eingelesen.
Alternativ kann man auch die CSV-Dateien in Excel öffnen und die Zellen auslesen, ist aber deutlich langsamer.
Gruß
Franz
'Erstellt unter Excel 2007
Sub Daten_holen()
Dim arrRoh, arrDaten(), Zeile As Long
Dim sFile As String, wksAusw As Worksheet
Const sPfad As String = "e:\rohdaten\"
Const sDelim As String = ";"
Application.ScreenUpdating = False
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("e:\rohdaten\auswertung rohdaten.xls").Sheets(1)
With wksAusw
'Spaltenformatierung kann weggelassen werden, wenn sie einmalig im Auswerteblatt gemacht  _
wird.
.Columns(1).NumberFormat = "DD/MM/YYYY"
.Columns(2).NumberFormat = "hh:mm:ss"
.Columns(3).NumberFormat = "#,##0.00"
.Columns(4).NumberFormat = "#,##0.00"
If .Cells(.Rows.Count - 1, 1)  "" Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
GoTo Beenden
End If
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
sFile = Dir(sPfad & "*.csv")
Do While sFile  ""
With wksAusw
Zeile = Zeile + 1
If Zeile >= .Rows.Count Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
Exit Do
End If
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 4)
arrDaten(1, 1) = CDbl(CDate(Split(arrRoh(5), sDelim)(1)))
arrDaten(1, 2) = CDbl(CDate(Split(arrRoh(6), sDelim)(1)))
arrDaten(1, 3) = Split(arrRoh(97), sDelim)(1)
arrDaten(1, 4) = Split(arrRoh(97), sDelim)(2)
.Cells(Zeile, 1).Value = arrDaten(1, 2)
.Cells(Zeile, 2).Value = arrDaten(1, 1)
.Cells(Zeile, 3).Value = IIf(IsNumeric(arrDaten(1, 3)), CDbl(arrDaten(1, 3)), arrDaten( _
1, 3))
.Cells(Zeile, 4).Value = IIf(IsNumeric(arrDaten(1, 4)), CDbl(arrDaten(1, 4)), arrDaten( _
1, 4))
End With
Erase arrDaten, arrRoh
sFile = Dir
Loop
Beenden:
Application.ScreenUpdating = True
wksAusw.Parent.Save
Set wksAusw = Nothing
End Sub
'Erstellt unter Excel 2007
Sub Daten_holen_Variante()
Dim Zeile As Long
Dim sFile As String, wksAusw As Worksheet, wbTemp, wksTemp As Worksheet
Const sPfad As String = "e:\rohdaten\"
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("e:\rohdaten\auswertung rohdaten.xls").Sheets(1)
With wksAusw
If .Cells(.Rows.Count - 1, 1)  "" Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
GoTo Beenden
End If
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
sFile = Dir(sPfad & "*.csv")
Application.ScreenUpdating = False
With wksAusw
Do While sFile  ""
Zeile = Zeile + 1
If Zeile >= .Rows.Count Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
Exit Do
End If
Application.Workbooks.OpenText Filename:=sPfad & sFile, origin:=xlWindows, _
DataType:=xlDelimited, Tab:=False, semicolon:=True, comma:=False, Space:=False, _
Local:=True
Set wbTemp = ActiveWorkbook
Set wksTemp = wbTemp.Worksheets(1)
.Cells(Zeile, 1).Value = wksTemp.Range("B7")
.Cells(Zeile, 2).Value = wksTemp.Range("B6")
.Cells(Zeile, 3).Value = wksTemp.Range("B98")
.Cells(Zeile, 4).Value = wksTemp.Range("C98")
wbTemp.Close savechanges:=False
Name sPfad & sFile As sPfad & sFile & "_x" 'als verarbeitet kennzeichnen
sFile = Dir
Loop
End With
Beenden:
Application.ScreenUpdating = True
wksAusw.Parent.Save
Set wbTemp = Nothing: Set wksTemp = Nothing: Set wksAusw = Nothing
End Sub

Anzeige
AW: CSV hochladen
02.08.2011 09:01:24
Johannes
Hallo Franz,
Entschuldigung, dass ich erst jetzt auf meine Anfrage zurückkomme - Dein Code 1 läuft auch gut. Ich stelle aber fest, dass teilweise die *.csv mehrfach in die Auswertung geraten. Man sieht es dran, dass die Endung dann so aussieht
Meas_C1_Kanal_1_Prg01_2011-06-28_06-20-41_.csv_x_x_x_x
hier wurde die Datei 4 mal ausgewertet, warum auch immer. Daher die Frage ob man nicht mit einer "Kill" Anweisung die Datei, die gerade ausgewertet wurde löschen kann.
Wenn Du hier nochmal schauen könntest, wäre ich Dir sehr verbunden. Danke.
Gruß
Johannes
AW: CSV hochladen
02.08.2011 13:14:16
fcs
Hallo Johannes,
die ausgewerteten Dateien müssen ggf. anders umbenannt werden oder alternativ mit Kill gelöscht werden.
Kill ist aber sehr rigoros, da die Dateien nicht im Papierkorb landen.
Gruß
Franz
Sub Daten_holen()
Dim arrRoh, arrDaten(), Zeile As Long, iPos As Long
Dim sFile As String, wksAusw As Worksheet
Const sPfad As String = "C:\Users\Public\Test\01\"
Const sPfad As String = "e:\rohdaten\"
Application.ScreenUpdating = False
'Auswertedatei öffnen
Set wksAusw = Workbooks.Open("e:\rohdaten\auswertung rohdaten.xls").Sheets(1)
With wksAusw
'Spaltenformatierung kann weggelassen werden, wenn sie einmalig im Auswerteblatt gemacht  _
wird.
.Columns(1).NumberFormat = "DD/MM/YYYY"
.Columns(2).NumberFormat = "hh:mm:ss"
.Columns(3).NumberFormat = "#,##0.00"
.Columns(4).NumberFormat = "#,##0.00"
If .Cells(.Rows.Count - 1, 1)  "" Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
GoTo Beenden
End If
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
sFile = Dir(sPfad & "*.csv")
Do While sFile  ""
With wksAusw
Zeile = Zeile + 1
If Zeile >= .Rows.Count Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
Exit Do
End If
Open sPfad & sFile For Input As #1
arrRoh = Split(Input(LOF(1), 1), vbLf)
Close #1
iPos = InStrRev(sFile, ".")
Name sPfad & sFile As sPfad & Left(sFile, iPos) & "x_csv" 'als verarbeitet kennzeichnen
'oder
'        Kill sPfad & sFile
ReDim arrDaten(1 To 1, 1 To 4)
arrDaten(1, 1) = CDbl(CDate(Split(arrRoh(5), sDelim)(1)))
arrDaten(1, 2) = CDbl(CDate(Split(arrRoh(6), sDelim)(1)))
arrDaten(1, 3) = Split(arrRoh(97), sDelim)(1)
arrDaten(1, 4) = Split(arrRoh(97), sDelim)(2)
.Cells(Zeile, 1).Value = arrDaten(1, 2)
.Cells(Zeile, 2).Value = arrDaten(1, 1)
.Cells(Zeile, 3).Value = IIf(IsNumeric(arrDaten(1, 3)), CDbl(arrDaten(1, 3)), arrDaten( _
1, 3))
.Cells(Zeile, 4).Value = IIf(IsNumeric(arrDaten(1, 4)), CDbl(arrDaten(1, 4)), arrDaten( _
1, 4))
End With
Erase arrDaten, arrRoh
sFile = Dir
Loop
Beenden:
Application.ScreenUpdating = True
wksAusw.Parent.Save
Set wksAusw = Nothing
End Sub

Anzeige
AW: CSV hochladen
03.08.2011 07:39:26
Johannes
Hallo Franz,
kurze Rückmeldung: Kill klappt auch super. Das rigerose Löschen ist OK, da es sich nicht um die Orignaldateien, sondern um Kopien handelt - die Originaldaten werden 15 Jahre archiviert - die QS will es so. Auswertungen mache ich immer nur an Kopien - und die kann ich anschließend löschen, sonst platzt irgendwann meine Festplatte ;-)
Danke nochmal und einen schönen Tag
Gruß
Johannes

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige