Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1312to1316
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

Summenprodukt durch Makro berechnen

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

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

Betreff
Datum
Anwender
Anzeige
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

Anzeige
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

Anzeige
@Erich, nicht schlecht, gute Idee oT.
27.05.2013 14:57:08
Tino

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige