AW: Messwerte aufbereiten
28.10.2015 09:06:50
matthias
Hallo Roman,
um das ganze leichter zu machen gibt es sogenannte Excel-Vorlagen mit Makros. Dort liegt bereits dein Linien-Diagramm, welches du dann nicht aufwendig per VBA erstellen musst, sondern vorher per Hand so einrichtest wie es dir beliebt. Damit musst du dich nur um den Import und die Aufteilung der Daten kümmern.
Hier zunächst ein einfacher Import:
Sub Dateiimport()
Dim myFileAddress As Variant
Application.ScreenUpdating = False
Application.Calculation = xlManual
' Standard-Verzeichnis festlegen
SetCurrentDirectory "C:\User\Desktop"
' Dateiimport
myFileAddress = Application.GetOpenFilename("CSV-Dateien (*.csv), *.csv")
If myFileAddress = False Then GoTo Endmarke 'Wenn Abbrechen gewählt
With Sheets("Import").QueryTables.Add(Connection:="TEXT;" & myFileAddress, _
Destination:=Sheets("Import").Range("A1"))
.Name = "Import"
'Eigenschaften über "Externe Daten abrufen" und Makrorecorder bestimmen
.FieldNames = True
.RowNumbers = False
.Refresh BackgroundQuery:=False
End With
Endmarke: 'Grundeinstellungen wiederherstellen
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Der Import ist nicht ganz vollständig, denn er muss von dir auf deine spezielle Datei angepasst werden. Dazu schmeiße den Makro-Recorder an und führe den Import ein Mal manuell durch (Reiter "Daten" - Externe Daten abrufen und dem Assistenten folgen). Danach die Eigenschaften an der entsprechenden Stelle in obiges Makro einfügen.
Die Teile-Erkennung ist recht simpel, da du ja ein sehr schönes Muster hast.
Sub TeileErkennung()
Dim x As Long, lSpalte As Long
Dim rZelle1 As Range, rZelle2 As Range
Application.ScreenUpdating = False
Application.Calculation = xlManual
With Sheets("Import")
Set rZelle1 = .Range("A2")
lSpalte = 1
For x = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(x, 1) > .Cells(x + 1, 1) Then
Set rZelle2 = .Cells(x, 2)
Sheets("Auswertung").Cells(1, lSpalte) = "Teil " & Int(lSpalte / 2) + 1
Range(rZelle1, rZelle2).Copy Destination:=Sheets("Auswertung").Cells(2, lSpalte)
lSpalte = lSpalte + 2
Set rZelle1 = .Cells(x + 1, 1)
End If
Next x
End With
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Ich habe angenommen, dass deine Daten eine Überschrift haben, darum rZelle1 zu Beginn als "A2" festgelegt. Sollte dies nicht der Fall sein, ändere dies bitte auf "A1" und zwei Zeilen darunter aus "For x = 2 To ..." --> "For x = 1 To ..." machen.
Statt ein neues Tabellenblatt zu erstellen, hast du in der Vorlage bereits ein Tabellenblatt (hier "Auswertung") erstellt, sodass dies ebenfalls nicht im Makro erfolgen muss.
Erstelle dir nun noch einen Active-X-Button im Blatt "Import" und Rechtsklick auf diesen - " _
Code Anzeigen". Dort dieses Event reinschmeißen:
Private Sub CommandButton1_Click()
Call Dateiimport
Call TeileErkennung
End Sub
Wenn alles passt, leere die eingetragenen Daten und speichere die Datei als Typ "Excel-Vorlage mit Makros", damit du diese wiederverwenden kannst.
lg Matthias