Summenprodukt durch Makro berechnen

Forumthread: Summenprodukt durch Makro berechnen

26.05.2013 20:45:21

Andre´

Hallo alle zusammen,
gibt es eine Möglichkeit die Summenproduktfunktion mit einem Makro zu realisieren, da die Berechnung bei immer mehr Daten relativ lange dauert.
In dem angehängten Bsp. https://www.herber.de/bbs/user/85533.xlsx ist in der Tabelle Auswertung im Bereich von C2:X25
die Funktion, wo ich gern nur die Werte stehen haben möchte.
Ich hoffe mir kann jemand helfen.
Vielen Dank im Voraus!
MFG Andre

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Summenprodukt durch Makro berechnen

26.05.2013 21:56:13

Tino

Hallo,
habe Dir mal zwei Varianten eingebaut,
welche für dich besser kannst Du selbst entscheiden.
https://www.herber.de/bbs/user/85535.xlsm
Gruß Tino

AW: Summenprodukt durch Makro berechnen

26.05.2013 22:38:14

Andre´

Hallo Tino,
ertmal vielen Dank für Deine Hilfestellung.
Es funktioniert noch nicht zu 100%, weil die Formeln im Bereich A2:B25 erhalten bleiben sollen.
Ich hoffe Du kannst mir weiter helfen!
MFG Andre

AW: Summenprodukt durch Makro berechnen

26.05.2013 22:50:33

Tino

Hallo,
hier die angepasste Version.
https://www.herber.de/bbs/user/85536.xlsm
Gruß Tino

AW: Summenprodukt durch Makro berechnen

26.05.2013 23:06:51

Andre´

Hallo Tino,
vielen Dank, jetzt läuft alles wie gewünscht.
Ich werde mir Deinen Code nächste Woche genauer anschauen, um zu verstehen wie er funktioniert!
MFG Andre

Schneller mit Dictionary

27.05.2013 14:09:51

Erich

Hi André,
da es dir wohl auch um Geschwindigkeit geht, noch eine dritte Variante:


Sub Dict()
Dim lngQ As Long, arrQ, oDic As Object, sTxt As String
Dim zz As Long, nInd As Long, arA()
With Sheets("Auswertung")              ' Auswertungszeilen
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row - 1   ' Anz. in Sp. A = 1
arrQ = .Cells(2, 1).Resize(lngQ, 2)
Set oDic = CreateObject("Scripting.Dictionary")
ReDim arA(1 To 22)
For zz = 1 To lngQ
oDic(arrQ(zz, 1) & "#" & arrQ(zz, 2)) = arA
Next zz
End With
With Sheets("Daten")                   ' Quelldaten
lngQ = .Cells(.Rows.Count, 6).End(xlUp).Row - 33   ' Anz. in Sp. F = 6
arrQ = .Cells(34, 6).Resize(lngQ, 4)               ' Quellwerte
For zz = 1 To lngQ
sTxt = arrQ(zz, 1) & "#" & arrQ(zz, 2)
If oDic.Exists(sTxt) Then
arA = oDic(sTxt)
For nInd = Application.RoundUp(48 * arrQ(zz, 3), 0) - 13 _
To Application.RoundUp(48 * arrQ(zz, 4), 0) - 14
arA(nInd) = arA(nInd) + 1     ' Weiterzählen
Next nInd
oDic(sTxt) = arA
End If
Next zz
End With
arrQ = oDic.Items                      ' restl. Daten (Array)
ReDim arA(oDic.Count - 1, 1 To 22)
For zz = 0 To oDic.Count - 1           ' Übertrag in 1 Array
For nInd = 1 To 22
arA(zz, nInd) = 0 + arrQ(zz)(nInd)
Next nInd
Next zz
With Sheets("Auswertung")              ' Ausgabe in Zielblatt
.Cells(2, 3).Resize(oDic.Count, 22) = arA
End With
End Sub

In dieser Mappe können die drei Varianten mit einem Zeitvergleich gestartet werden:
https://www.herber.de/bbs/user/85543.xlsm
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

@Erich, nicht schlecht, gute Idee oT.

27.05.2013 14:57:08

Tino

Beliebteste Forumthreads (12 Monate)

Summenprodukt durch Makro berechnen

Forumthread: Summenprodukt durch Makro berechnen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Summenprodukt durch Makro berechnen

Forumthread: Summenprodukt durch Makro berechnen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread