[VBA] Mittelwert bilden aus Uhrzeit/Messwert

Hallo,
von einem Sensor bekomme ich eine CSV-Datei, welche ich nach dem Import in meine Excel-Tabelle mit einem VBA-Makro weiterbearbeiten möchte.
Der Sensor liefert mir Messwerte zur Stromspannung und misst ca. 60x in der Minute. Diese Messfrequenz ist für meinen Zweck allerdings viel zu hoch - ich benötige lediglich eine Messung im Minutenrhythmus. Nun möchte ich die Messwerte für jede Minute zusammenfassen und den Mittelwert bilden.
Ich habe zwei Spalten:

Eine Spalte gibt die Uhrzeit der Messung an "B"

Eine Spalte gibt den Messwert der Messung an "C"

Die beiden Spalten haben jeweils das Format "Uhrzeit" bzw. "Zahl".
Wie stelle ich es am elegantesten an eine Schleife zu bauen, die für alle auf dem Arbeitsblatt anfallenden Stunden/Minutenkombinationen die kumulierten Werte ausgibt?
Gruß
Heinz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
probier mal folgenden Code
er ist geschrieben für die zweispaltige Variante (Datum + Zeit in einer Zelle)
das Worksheetfunction.Floor entspricht der Funktion Untergrenze (Abrunden auf ein Vielfaches des angegebenen Wertes).

Sub test()
Dim dicSumme As Object
Dim dicAnzahl As Object
Dim arr
Dim z As Long
Dim T
Set dicSumme = CreateObject("Scripting.Dictionary")
Set dicAnzahl = CreateObject("Scripting.dictionary")
arr = Cells(2, 1).CurrentRegion.Value
For z = 1 To UBound(arr, 1)
If IsDate(arr(z, 1)) Then
T = WorksheetFunction.Floor(CDate(arr(z, 1)), TimeSerial(0, 1, 0))
dicSumme(T) = dicSumme(T) + arr(z, 2)
dicAnzahl(T) = dicAnzahl(T) + 1
End If
Next
ReDim arr(1 To dicSumme.Count, 1 To 2)
z = 0
For Each T In dicSumme.keys
z = z + 1
arr(z, 1) = T
arr(z, 2) = dicSumme(T) / dicAnzahl(T)
Next
Cells(2, 4).Resize(UBound(arr, 1), 2) = arr
End Sub

wenn du das Dictionary-Objekt nicht kennst, hier noch eine Variante für normale Arrays.
Datum-Urzeit wird hier in einen passenden Index umgerechnet (1 min = 1)

Sub test2()
Dim Erg
Dim arr
Dim z As Long
Dim T
With Cells(2, 1).CurrentRegion
arr = .Value
ReDim Erg(Int(WorksheetFunction.Min(.Columns(1)) * 60 * 24) To Int(WorksheetFunction.Max(. _
Columns(1)) * 60 * 24), 1 To 3)
End With
For z = 1 To UBound(arr, 1)
If IsDate(arr(z, 1)) Then
T = Int(CDate(arr(z, 1)) * 60 * 24)
Erg(T, 1) = CDate(T / 24 / 60)
Erg(T, 2) = Erg(T, 2) + arr(z, 2)
Erg(T, 3) = Erg(T, 3) + 1
End If
Next
For z = LBound(Erg, 1) To UBound(Erg, 1)
If Erg(z, 1) = "" Then
Erg(z, 1) = CDate(z / 24 / 60)
Else
Erg(z, 2) = Erg(z, 2) / Erg(z, 3)
Erg(z, 3) = ""
End If
Next
Cells(2, 5).Resize(UBound(Erg, 1) - LBound(Erg, 1) + 1, 2).Value = Erg
End Sub

es gibt noch einen funktionalen Unterschied zwischen beiden Codes:
sollten in der Aufzeichnung Lücken sein (bestimmte Minuten fehlen ganz)
so listet der erste Code nur die tatsächlich vorhandenen Minuten auf.
der zweite Code listet alle Minuten auf, die zwischen der ersten und letzen Minute liegen, in der zweiten Spalte bleiben die Felder dann leer.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

[VBA] Mittelwert bilden aus Uhrzeit/Messwert

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

[VBA] Mittelwert bilden aus Uhrzeit/Messwert

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread