[VBA] Mittelwert bilden aus Uhrzeit/Messwert

Forumthread: [VBA] Mittelwert bilden aus Uhrzeit/Messwert

25.05.2018 12:19:54

Heinz

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

AW: [VBA] Mittelwert bilden aus Uhrzeit/Messwert

25.05.2018 12:21:05

Heinz

Hier die Excel-Tabelle: https://www.herber.de/bbs/user/121820.xlsx

AW: [VBA] Mittelwert bilden aus Uhrzeit/Messwert

25.05.2018 13:28:13

Daniel

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

AW: [VBA] Mittelwert bilden aus Uhrzeit/Messwert

29.05.2018 09:55:49

Heinz

Hallo Daniel,
vielen Dank für den Tip - hat mir weiter geholfen :)
Gruß
Heinz

Beliebteste Forumthreads (12 Monate)

[VBA] Mittelwert bilden aus Uhrzeit/Messwert

Forumthread: [VBA] Mittelwert bilden aus Uhrzeit/Messwert

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

[VBA] Mittelwert bilden aus Uhrzeit/Messwert

Forumthread: [VBA] Mittelwert bilden aus Uhrzeit/Messwert

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread