das Loggen der Devices unter CUx ist eine hervorragende und sichere Methode (Danke, Uwe!). Nur das separate Darstellen unter Excel war etwas zeitaufwendig. Daher habe ich ein kleines Makro geschrieben, das evtl. auch anderen hilft. Voraussetzung ist, dass die importierten Daten in den Spalten A (Datum), B (Zeit), C (Bezeichnung) und D (Wert) sind und das Worksheet "DeviceLog" heißt. Es arbeitet nur, solange noch keine Worksheets vorhanden sind, die den Namen einer Bezeichnung tragen. Daher am besten vor dem Starten alle anderen Worksheets außer "DeviceLog" löschen!
Code: Alles auswählen
Sub Sortieren()
'
' Sortieren Makro
'
'
' Sortieren der Spalten
Dim src, dst, def As Worksheet
Dim lSRow&, lDRow&
Dim Wert_neu, Wert_alt
Dim Text_neu, Text_alt
Dim Zähler
Set src = ThisWorkbook.Worksheets("DeviceLog")
Columns("A:D").Select
ActiveWorkbook.Worksheets("DeviceLog").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DeviceLog").Sort.SortFields.Add Key:=Range( _
Cells(1, 3), Cells(src.Rows.Count, 3)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("DeviceLog").Sort.SortFields.Add Key:=Range( _
Cells(1, 1), Cells(src.Rows.Count, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("DeviceLog").Sort.SortFields.Add Key:=Range( _
Cells(1, 2), Cells(src.Rows.Count, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("DeviceLog").Sort
.SetRange Range("A1:D50000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Text_alt = ""
Wert_alt = 9999999
For lSRow = 1 To src.Cells(src.Rows.Count, 4).End(xlUp).Row
Text_neu = src.Cells(lSRow, 3)
Wert_neu = src.Cells(lSRow, 4)
Text_neu = Left$(Text_neu, Len(Text_neu) - 1)
If Text_neu <> Text_alt Then
If Text_alt <> "" Then
dst.Columns("A:B").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLines
ActiveChart.Location Where:=xlLocationAsNewSheet
Sheets(ActiveSheet.Name).Name = Text_alt + "_G"
End If
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(ActiveSheet.Name).Name = Text_neu
Set dst = ThisWorkbook.Worksheets(Text_neu)
dst.Columns("A:A").Select
Selection.ColumnWidth = 16
dst.Cells(1, 1) = "Timestamp"
dst.Cells(1, 2) = "Value"
Text_alt = Text_neu
lDRow = 2
End If
If Wert_neu <> Wert_alt Then
dst.Cells(lDRow, 1) = src.Cells(lSRow, 1) + src.Cells(lSRow, 2)
src.Cells(lSRow, 4).Copy Destination:=dst.Cells(lDRow, 2)
Wert_alt = Wert_neu
lDRow = lDRow + 1
End If
dst.Columns("A:B").Select
Next lSRow
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLines
ActiveChart.Location Where:=xlLocationAsNewSheet
Sheets(ActiveSheet.Name).Name = Text_alt + "_G"
End Sub