Hauptprogramm
Sub AuswertenDerCSVmitMAX()
Dim x As Double
Dim CSV As String
Dim wksZiel As Worksheet
Dim Zeile_Z As Long, zeile As Long
Dim varA, dblMax, dbTemp As Double
Dim wkbTxt As Workbook, wksTxt As Worksheet
Dim varOrdner As Variant, varDatei As Variant
Dim varData As Variant
Set wksZiel = ActiveSheet
varDatei = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If varDatei = False Then Exit Sub
Open varDatei For Input As #1
x = 0
Do While Not EOF(1)
Line Input #1, CSV
Cells(1, 1).Offset(x, 0) = CSV
x = x + 1
Loop
Close #1
z = Range("A4000").End(xlUp).Row
Range("A21:A" & z).Delete Shift:=xlUp
For j = 1 To 21
Text = Split(Cells(j, 1), ";")
For i = 0 To UBound(Text)
Cells(j, i + 1) = Text(i)
Next
Next
Call LöschenSpaltenZellen
With wksZiel
Zeile_Z = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte den Ordner mit den csv-Dateien auswählen"
If .Show = -1 Then
varOrdner = .SelectedItems(1)
Else
GoTo Beenden
End If
End With
Application.ScreenUpdating = False
varDatei = Dir(varOrdner & "\*.csv")
Do Until varDatei = ""
setzen wenn Daten nicht mit den lokalen Einstellungen der Systemsteuerung übereinstimmen.
Application.Workbooks.OpenText Filename:=varOrdner & "\" & varDatei, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, Tab:=False, semicolon:=True, comma:=False, _
Space:=True, other:=False, ThousandsSeparator:=".", DecimalSeparator:=",", _
Local:=True
Set wkbTxt = ActiveWorkbook
Set wksTxt = wkbTxt.Sheets(1)
With wksTxt
varData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2))
End With
varA = "no Data"
dblMax = -99999
If UBound(varData, 1) >= 21 Then
varA = varData(21, 1)
dblMax = varData(21, 2)
dbTemp = varData(21, 3)
For zeile = 21 To UBound(varData, 1)
If IsNumeric(varData(zeile, 1)) Then
If varData(zeile, 1) > dblMax Then
varA = varData(zeile, 1)
dblMax = varData(zeile, 2)
dbTemp = varData(21, 3)
End If
End If
Next
End If
wkbTxt.Close SaveChanges:=False
Erase varData
With wksZiel
Zeile_Z = Zeile_Z + 1
.Cells(Zeile_Z, 2) = dblMax
.Cells(Zeile_Z, 3) = dbTemp
End With
varDatei = Dir
Loop
Beenden:
Application.ScreenUpdating = True
Call Nummerierung
Call ZahlenFormatEinstellen
End Sub
Nebenprogramme
1)
Sub LöschenSpaltenZellen()
With Worksheets("Tabelle1")
Range("A20").ClearContents
Range("A21").Value = "Nr."
Range("B20").ClearContents
Range("B21").Value = "Einheit 1"
Range("C20").ClearContents
Range("C21").Value = "Einheit 2"
Range("C1:C19").ClearContents
Range("6:6,7:7,9:9,10:10,11:11,16:16").Select
Selection.Delete
End With
End Sub
2)
Sub Nummerierung()
Dim i As Long, n As Long
n = 1
With Sheets("Tabelle1")
For i = 16 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B") <> "" Then
.Cells(i, "A") = n
n = n + 1
End If
Next
End With
End Sub