Option Explicit
Sub Bsp()
Dim rngData As Excel.Range
With Worksheets("Tabelle1")
'data-section
Set rngData = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 3)
With rngData.Offset(, 3)
't[ms]->t[min]
.Columns(1).FormulaR1C1 = "=1+TRUNC(RC[-3]/60000,0)"
'AVG(T[°C]) for t[min]
.Columns(2).FormulaR1C1 = "=IF(AND(OR(RC[-1]=R[-1]C[-1],NOT(ISBLANK(R[-1]C[-1]))),NOT(ISBLANK(R[-1]C[-1])))," & _
"AVERAGEIF(" & .Columns(1).Address(ReferenceStyle:=xlR1C1) & ",RC[-1]," & .Columns(1).Offset(, -2).Address(ReferenceStyle:=xlR1C1) & "),"""")"
'MAX(V[ul]) for t[min]
.Columns(3).FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-3],"""")"
'formula-values to values
.Value = .Value
End With
Call rngData.Cells(1, 1).Offset(-1).Replace("[ms]", "[min]")
'delete no more needed data
Call rngData.Delete(xlShiftToLeft)
'data-section
Set rngData = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 3)
Call rngData.Sort(Key1:=.Cells(1), Order1:=xlAscending, Key2:=.Cells(2), Order2:=xlDescending)
Call rngData.RemoveDuplicates(1)
End With
End Sub
|