Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1500to1504
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Summe bilden nach jedem Zeitschritt

VBA Summe bilden nach jedem Zeitschritt
04.07.2016 17:08:59
Ben
Hallo zusammen,
Ich habe mir ein Modul geschrieben was die Summe einer Reihe bildet bis ein bestimmter Wert erreicht wird. Anschließend wird ab der nächsten Zelle wieder die Summe gebildet bis der Wert erreicht wird.

For j = 0 To anzzeilen
a = 0
For i = 3 To anzzeilen
a = Worksheets("Daten").Cells(i + j, 1) + a
If a >= 104.3 Then
Worksheets("Ergebnis").Cells(3 + j, 5) = a
Worksheets("Ergebnis").Cells(3 + j, 4) = i - 3
i = 0
Exit For
ElseIf Worksheets("Daten").Cells(i + j, 1) = Empty Then
Exit For
End If
Next
Next
Das Tool funktioniert so wie es soll, allerdings ist die Rechenzeit relativ hoch (bis zu 2 Minuten bei 6000 Einträgen).
Hat jmd. eine Idee wie ich die Schleife vereinfachen könnte?
Vielen Dank und schönen Wochenstart
Ben

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Was willst Du denn berechnen?
04.07.2016 17:27:36
Michael
Hallo Ben!
Unabhängig von Deinem bisherigen Code: Was soll jeweils berechnet werden, wo stehen die Daten? Formuliere das mal verbal, oder noch besser anhand eines kleinen Bsp-Auszugs Deiner Tabelle - dann schauen wir uns einen effizienten Code dafür an.
Deal?
Michael

AW: Was willst Du denn berechnen?
04.07.2016 18:13:00
Ben
Hallo Michael,
Deal! Komme allerdings erst morgen dazu. Werde dann genauer erörtern was ich vor habe.
Viele Grüße
Ben

AW: Was willst Du denn berechnen?
05.07.2016 11:11:05
Ben
Guten Morgen,
in meinem Worksheet sind bspw. in Spalte "A" viele Messwerte aufgezeichnet worden (bis zu 7000). In Zeile 1 steht der Name der Messgröße, in Zeile 2 die Einheit. In Spalte "B" ist dazu die Zeit in 1Hz Schritten aufgezeichnet:

CO2         Zeit
Kg          in Sekunden
2           0
3,4         1
2,9         2
1,7         3
2,3         4
3           5
2           6
4           7
2,7         8
2,9         9
0,5         10
2           6999
1           7000

In Spalte "C" soll jetzt die eigentliche Rechnung stattfinden. Ich fange an bei 0 Sekunden. In Spalte "A" soll jetzt solange die Summe gebildet werden, bis ein bestimmter Wert (bspw. >=10) erreicht wird. Nachdem der Wert erreicht wurde, soll der Wert in die Spalte "C" und Zeile 3 geschrieben werden.
In dem Beispiel wäre dies nach 4 Sekunden und so müsste der Wert 10 (2+3,4+2,9+1,7) in die Spalte "C" Zeile 3 geschrieben werden.
Anschließend erfolgt der nächste Rechenschritt. Die Summe soll jetzt ab der Zelle "A" Zeile 4 gebildet werden. Wieder soll die Summe solange gebildet werden, bis der Wert >= 10 erreicht wird. In Spalte "C" Zeile 4 muss somit der Wert 10,3 stehen (3,4+2,9+1,7+2,3).
Das ganze wiederholt sich, bis der Wert 10 nicht mehr erreicht werden kann. Dann soll die For-Schleife beendet werden.
Im Anhang habe ich eine Beispieldatei mit Makro angeheftet. Solltest du das Marko nicht öffnen wollen schreibe ich dir hier nochmal den Code:
Dim anzzeilen As Long
Dim i, j As Integer
Dim CO2 As Double
Sub Berechnung()
anzzeilen = Worksheets("Daten").UsedRange.Rows.Count                    'Anzahl der Zeilen  _
bestimmen
CO2_ref = 10                                                            'Referenzwert
For j = 0 To anzzeilen                                                  'Zeitschritt 1Hz
CO2 = 0
For i = 3 To anzzeilen
CO2 = Worksheets("Daten").Cells(i + j, 1) + CO2                 'Summenbildung
If CO2 >= CO2_ref Then
Worksheets("Daten").Cells(3 + j, 3) = CO2               'Wert der >= dem  _
Referenzwert ist
Worksheets("Daten").Cells(3 + j, 4) = i - 3             'Zeit nach wieviel  _
Sekunden der Wert erreicht wurde
i = 0
Exit For
ElseIf Worksheets("Daten").Cells(i + j, 1) = Empty Then     'Abbrechen wenn  _
Summenicht gebildet werden kann
Exit For
End If
Next
Next
End Sub
In dem Code wird noch eine zusätzliche Spalte eingefügt. Diese dient dazu mir rauszuschreiben, nach wieviel Sekunden die Summe gebildet wurde (Spalte "D" Zeile 3)
https://www.herber.de/bbs/user/106766.xlsm
Viele Grüße
Ben

Anzeige
AW: Was willst Du denn berechnen?
05.07.2016 13:10:57
Michael
Hallo Ben!
Meine Idee dazu, in Deiner Bsp-Datei:

Die Datei https://www.herber.de/bbs/user/106768.xlsm wurde aus Datenschutzgründen gelöscht


Teste Mal; Makro "Sub a()" liegt im Modul 2.
Hab ich Dich richtig verstanden?
LG
Michael

AW: Was willst Du denn berechnen?
05.07.2016 13:30:31
Ben
Hallo Michael,
du hast mich richtig verstanden, vielen Dank!
Ich habe jetzt mal meine Original-Daten in die Datei geschrieben und beide Methoden verglichen (Hätte ich besser gleich gemacht, sorry). Die von dir ist mit einer Rechendauer von 28 Sekunden um 3 Sekunden schneller. Glaubst du es gibt eine Möglichkeit die Rechenlaufzeit auf ca. die Hälfte zu reduzieren?
Hier die Datei: https://www.herber.de/bbs/user/106770.xlsm
Ich habe auch den Referenzwert angepasst.
Schönen Gruß
Ben

Anzeige
Klar geht das schneller...
05.07.2016 15:32:02
Michael
Ben,
ich weiß nur nicht, warum ich nicht vorher drauf gekommen bin; vermutlich weil ich ignoriert hab, das die Werte bei Dir in die mehreren Tausend gehen.
Also mit Array, statt im Blatt:
Sub b()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim aW
Dim i As Long
Dim s As Double
Dim j As Long
Dim clc
With Application
clc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set Wb = ThisWorkbook
Set Ws = Wb.Worksheets("Daten")
With Ws
aW = Application.Transpose(.Range("A3:A" & .Cells(.Rows.Count, 1).End(xlUp).Row))
End With
For i = 1 To UBound(aW)
s = aW(i)
j = i
Do While s  UBound(aW) Then Exit For
s = s + aW(j)
Loop
Ws.Cells(i + 2, 3) = s
Next i
Set Wb = Nothing
Set Ws = Nothing
Erase aW
With Application
.Calculation = clc
.ScreenUpdating = True
End With
End Sub
Probier mal. Ist jetzt schon auf den neuen Referenzwert eingestellt.
LG
Michael

Anzeige
AW: Klar geht das schneller...
05.07.2016 16:08:17
Ben
Das ist ja ein Traum! Perfekt! Nicht mal eine Sekunde!
Ich werde mir den Code später nochmal genau anschauen, will ihn ja nicht nur in das Gesamttool schreiben, sondern auch verstehen.
Vielen vielen Dank!

Gern, + kleine Erläuterung bei Interesse
05.07.2016 16:27:15
Michael
Hallo Ben!
Freut mich zu hören; ist kein Hexenwerk der Code, hier mit Kommentaren:
Sub b()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim aW
Dim i As Long
Dim s As Double
Dim j As Long
Dim clc
'Performance erhöhen
With Application
clc = .Calculation 'Modus der Formelberechnung merken
.Calculation = xlCalculationManual 'Autom. Formelberechnung AUS
.ScreenUpdating = False 'Bildschirm-Aktualisierung AUS
End With
'Mappe, Blatt und Bereich der Werte bestimmen
Set Wb = ThisWorkbook
Set Ws = Wb.Worksheets("Daten")
With Ws
'Gesamter Wertebereich wird in ein Array geschrieben
aW = Application.Transpose(.Range("A3:A" & .Cells(.Rows.Count, 1).End(xlUp).Row))
End With
'Anstatt die einzelnen Zellen durchzugehen, die Array-Elemente bearbeiten
'1 bis zum letzten Element des Arrays (= Wert der letzten Zelle des Werte-Bereichs)
For i = 1 To UBound(aW)
'Summe ist zunächst der Wert des i-Elements des Arrays
s = aW(i)
j = i 'Ein Zähler
'Solange die Summe  UBound(aW) Then Exit For
'Zur Summe wird jeweils der Wert des j-Elements des Arrays zugeschlagen
s = s + aW(j)
Loop
'Array startet ab 1, die Zielzellen aber erst ab Zeile 3
'deshalb schreiben wir die jeweilige Summe immer in die Zelle i + 2 (in die 3. Spalte)
Ws.Cells(i + 2, 3) = s
Next i
'Aufräumen
Set Wb = Nothing
Set Ws = Nothing
Erase aW
With Application
.Calculation = clc
.ScreenUpdating = True
End With
End Sub
LG
Michael

Anzeige
AW: Gern, + kleine Erläuterung bei Interesse
06.07.2016 14:59:24
Ben
Hallo Michael,
durch das Einfügen des Codes in mein Excel-Tool hat sich die Gesamtrechenzeit von 2 Minuten auf jetzt nur noch ~20 Sekunden verkürzt. Ich habe mir noch die "Zeit" (j) ausgeben lassen, zusätzliche zwei weitere Summen einer angrenzenden Spalte und den Mittelwert einer Spalte ausgeben lassen (siehe Code).
(nicht schön, aber es klappt ;-) )
Option Explicit
Sub Summenbildung()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim Ws1 As Worksheet
Dim aW, aW1, aW2, aW3
Dim i As Long
Dim s As Double
Dim s1 As Double
Dim s2 As Double
Dim s3 As Double
Dim j As Long
Dim clc
'Performance erhöhen
With Application
clc = .Calculation 'Modus der Formelberechnung merken
.Calculation = xlCalculationManual 'Autom. Formelberechnung AUS
.ScreenUpdating = False 'Bildschirm-Aktualisierung AUS
End With
'Mappe, Blatt und Bereich der Werte bestimmen
Set Wb = ThisWorkbook
Set Ws = Wb.Worksheets("Daten")
With Ws
'Gesamter Wertebereich wird in ein Array geschrieben
aW = Application.Transpose(.Range("A3:A" & .Cells(.Rows.Count, 1).End(xlUp).Row))
aW1 = Application.Transpose(.Range("B3:B" & .Cells(.Rows.Count, 1).End(xlUp).Row))
aW2 = Application.Transpose(.Range("D3:D" & .Cells(.Rows.Count, 1).End(xlUp).Row))
aW3 = Application.Transpose(.Range("E3:E" & .Cells(.Rows.Count, 1).End(xlUp).Row))
End With
'Anstatt die einzelnen Zellen durchzugehen, die Array-Elemente bearbeiten
'1 bis zum letzten Element des Arrays (= Wert der letzten Zelle des Werte-Bereichs)
For i = 1 To UBound(aW)
'Summe ist zunächst der Wert des i-Elements des Arrays
s = aW(i)
s1 = aW1(i)
s2 = aW2(i)
s3 = aW3(i)
j = i 'Ein Zähler
'Solange die Summe  UBound(aW) Then Exit For
'Zur Summe wird jeweils der Wert des j-Elements des Arrays zugeschlagen
s = s + aW(j)
s1 = s1 + aW1(j)
s2 = s2 + aW2(j)
s3 = s3 + aW3(j)
Loop
'Array startet ab 1, die Zielzellen aber erst ab Zeile 3
'deshalb schreiben wir die jeweilige Summe immer in die Zelle i + 2 (in die 3. Spalte)
Set Ws = Wb.Worksheets("MAW")
Ws.Cells(i + 2, 5) = s
Ws.Cells(i + 2, 6) = s1
Ws.Cells(i + 2, 7) = s2 / (j - i + 1)            'Mittelwert
Ws.Cells(i + 2, 8) = s3
Worksheets("MAW").Cells(i + 2, 3) = j - 1        'Zeitpunkt Ende (letzte Stelle)
Next i
'Aufräumen
Set Wb = Nothing
Set Ws = Nothing
Erase aW
With Application
.Calculation = clc
.ScreenUpdating = True
End With
End Sub
Ich habe noch weitere Punkte gefunden wo ich die Rechenzeit verkürzen kann. Allerdings sind es oft nur Kleinigkeiten.
Hast du allgemein eine Empfehlung wo ich mir das Programmieren mit Arrays aneignen kann?
Nochmal vielen Dank!

Anzeige
Arrays...
06.07.2016 16:50:47
Michael
Hallo Ben!
Zu Deiner obigen Kreation: Wenn Du einen mehrspaltigen Bereich abarbeiten willst, anstatt wie in der Ausgangsfrage eine Spalte, dann musst Du dafür nicht mehrere Arrays anlegen; dann empfiehlt es sich den Bereich in einem, aber mehrdimensionalen, Array abzulegen (s. schematisch unten).
Bzgl. Infos zu Arrays: Es gibt dazu viel im Netz, google Dich mal durch, insbesondere auch auf englischen Seiten (Suchworte: excel vba arrays bspw.). Guter Einstieg: http://www.online-excel.de/excel/singsel_vba.php?f=152
Und der Rest ist dann einfach Ausprobieren und selbst anwenden, daran führt sowieso kein Weg vorbei.
Schema für mehrspaltigen Bereich im Code:
    'Deklarationen etc.
'Bereich A3:Dx in Array auslagern
With Ws
aW = .Range("A3:D" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
For i = 1 To UBound(aW, 1) ' Ubound (aw, 1)!!!
s = aW(i, 1)
s1 = aW(i, 2)
'usw. ...
Do While s  UBound(aW, 1) Then Exit For ' Ubound (aw, 1)!!!
s = s + aW(j, 1) ' Ubound (aw, 2)!!!
s1 = s1 + aW(j, 2) ' Ubound (aw, 2)!!!
'usw. ...
Loop
Ws.Cells(i + 2, 5) = s
Ws.Cells(i + 2, 6) = s1
'usw. ...
Next i
'usw. ...
LG
Michael

Anzeige
AW: Was willst Du denn berechnen?
05.07.2016 13:41:44
IngoG
Hallo Ben,
das geht zB auch mit einer Formellösung:
in a2:a6000 stehen deine Werte, in e2 Dein Grenzwert (hier 104,3)
dann trägst Du in b2 folgende Formel ein und kopierst sie nach unten bis zur Zeile 6000 oder länger:
=WENN(SUMME($A$2:$A2)-SUMME($B$1:$B1)>$E$2;SUMME($A$2:$A2)-SUMME($B$1:$B1);"")
die Berechnung Dauert für 6000 Zeilen ca 10s
Du kannst das nat. auch in VBA umsetzen, sollte deutlich schneller laufen als Deine Mehrschleifenlösung.
Als Beispiel:
https://www.herber.de/bbs/user/106771.xlsm
Ich hoffe, das hilft Dir weiter
Gruß Ingo

Anzeige
AW: Was willst Du denn berechnen?
05.07.2016 14:05:17
Ben
Hallo Ingo,
vielen Dank für deine Antwort!
Das Makro soll, nachdem der Grenzwert erreicht wurde, eine Zeile weiter springen (bspw. von A3 auf A4) und von neuem die Summe bilden.
Hier die Beispieldatei: https://www.herber.de/bbs/user/106770.xlsm
Dort hat Michael in Makro 2 seine Lösung präsentiert. In Makro 1 ist die von mir programmierte Schleife.
Schöne Grüße
Ben

AW: Was willst Du denn berechnen?
05.07.2016 14:13:17
IngoG
Hallo Ben,
das macht die obige Formel auch und das Makro in meinem Anhang ebenfalls ;-)
Da Du sagtest, dass die Zeit ein Problem darstellt, kannst Du es ja mal damit versuchen.
Bei mir hat beides keine 28s gedauert...
Gruß Ingo
PS Die Formel kannst Du ja anschließend durch werte ersetzen.

Anzeige
AW: Was willst Du denn berechnen?
05.07.2016 14:27:40
Ben
Hallo Ingo,
ich hab mich bissl umständlich ausgedrückt. Bzw. wenn ich deine Formel richtig verstanden habe:
Es wird die Summe bis zum Grenzwert gebildet. Danach fängt die neue Berechnung an ab dem Punkt wo der Grenzwert gefunden wurde. Richtig?
Was ich meinte (basierend auf deiner Excel-Datei):
In Zelle "B2" soll der Wert stehen nachdem der Grenzwert erreicht wurde, also in diesem Beispiel die 104,63. Danach fängt das ganze mit Zelle "B3" an. Hier müsste dann der Wert 120,96 (A3+A4+A5+...+A15) ausgerechnet werden. Anschließend wiederholt sich das ganze mit Zelle "B4".
Viele Grüße
Ben
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige