CSV effizient einlesen
15.04.2020 23:14:24
dx145
Ich habe aus Messungen eine Menge csv Files, die heissen alle gleich unterscheiden sich nur anhand der Nummer in Klammern. Daher lese ich zuerst die Dateinamen ein und sortiere diese Anhand der Nummern in den Klammern. Diese CSV Files haben 3 Spalten und mehrere Tausend Zeilen. Diese will ich nebeneinander in excel darstellen, dass ich nachher eine Datenauswertung machen kann. Funktioniert auch alles nicht schlecht, nur das einlesen ist Sau langsam und wenn ich viele Daten habe schmmiert das System ab. -> keine Rückmeldung... Bei drei csv Dateien dauert es so 20s. Bei 20 ewig... es können aber auch mal 100 werden...
Geht das irgendwie effiienter?
Es geht vor allem um die CSVlesen Funktion
Der Code sieht wiefolgt aus:
Const MEASUREMENT_TITLE_ROW = 20
Const FIRST_MEASUREMENT_COLUMN = 5
Const SPACE_FOR_MEASUREMENT = 4
Sub formateFile()
Call bordersAndUnionAndInput("B6", "D6", "Status:")
Call bordersAndUnionAndInput("B7", "D7", "Inactive")
Call bordersAndUnionAndInput("F6", "H6", "Status:")
Call bordersAndUnionAndInput("F7", "H7", "Inactive")
Call bordersAndUnionAndInput("F8", "H8", "Anzahl Werte zur Mittelung:")
Call bordersAndUnionWithoutInput("F9", "H9")
Call bordersAndUnionAndInput("J6", "L6", "Status:")
Call bordersAndUnionAndInput("J7", "L7", "Inactive")
Call bordersAndUnionAndInput("J8", "L8", "Anzahl Werte zur Mittelung:")
Call bordersAndUnionWithoutInput("J9", "L9")
Call bordersAndUnionAndInput("N6", "P6", "Status:")
Call bordersAndUnionAndInput("N7", "P7", "Inactive")
Call bordersAndUnionAndInput("N8", "P8", "Zu plottende Messungsnummer:")
Call bordersAndUnionWithoutInput("N9", "P9")
Cells(MEASUREMENT_TITLE_ROW, 1).Value = "Pfad der Messung:"
Cells(MEASUREMENT_TITLE_ROW, 2).Value = "Messungsnr."
Cells(MEASUREMENT_TITLE_ROW - 1, 1).Value = "Mittelung der Maximalwerte"
Cells(MEASUREMENT_TITLE_ROW - 2, 1).Value = "Mittelung DC Werte"
End Sub
Sub CSVlesenV()
Call formateFile
Range("B7").Value = "Running"
Dim i, j As Integer, arrDaten, arrDaten2, arrTmp, lngR As Long
Dim line As String
Dim arrayOfElements
Dim linenumber As Integer
Dim elementnumber As Integer
Dim element As Variant
Dim csvPath As String
Set fso = CreateObject("Scripting.Filesystemobject")
csvPath = ThisWorkbook.Path + "\Messungen"
linenumber = 0
elementnumber = 0
i = MEASUREMENT_TITLE_ROW + 1
For Each f In fso.GetFolder(csvPath).Files
If LCase(Right(f.Name, 3)) = "csv" Then
Cells(i, 1).Value = f.Path
If InStr(f.Path, "(") 0 Then
Cells(i, 2).Value = Mid(f.Path, InStr(f.Path, "(") + 1, InStr(f.Path, ")") - _
InStr(f.Path, "(") - 1)
'Cells(i, 2).Value = 0
Else
Cells(i, 2).Value = 1
End If
i = i + 1
End If
Next
Call A_B_Sortieren(MEASUREMENT_TITLE_ROW + 1, 1, i - MEASUREMENT_TITLE_ROW - 1)
'GoTo Sprungmarke
j = FIRST_MEASUREMENT_COLUMN
i = MEASUREMENT_TITLE_ROW + 1
Do While Cells(i, 1).Value ""
linenumber = 0
elementnumber = 0
Open Cells(i, 1).Value For Input As #1 ' Open file for input
Do While Not EOF(1) ' Loop until end of file
linenumber = linenumber + 1
Line Input #1, line
arrayOfElements = Split(line, ";")
elementnumber = 0
Cells(MEASUREMENT_TITLE_ROW, j).Value = "Messung " & i - MEASUREMENT_TITLE_ROW
For Each element In arrayOfElements
elementnumber = elementnumber + 1
Cells(MEASUREMENT_TITLE_ROW + 1 + linenumber, j - 1 + elementnumber).Value = _
element
Next
Loop
Close #1 ' Close file.
j = j + SPACE_FOR_MEASUREMENT
i = i + 1
Loop
Range("B7").Value = "Finished"
End Sub
Sub A_B_Sortieren(Ez As Long, Spalte As Long, AnzZeilen As Long)
Range(Cells(Ez, Spalte), Cells(Ez + AnzZeilen, Spalte + 1).End(xlUp)).Select
Selection.Sort key1:=Cells(Ez, Spalte + 1), order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal 'sortiert
'Range("A1").Select 'geht auf Zelle A1
End Sub
