AW: grosse Datenmengen mit sumproduct und Array ausw.?
13.08.2010 00:06:50
fcs
Hallo Peter,
VBA-Prozeduren sind in den seltesten Fällen schneller als die direkte Anwendung von Funktionen in den Tabellen.
Ein Weg um die Berechnungszeiten in den Tabellen zu minimieren kann dann sein, Formeln in die Zellen einzutragen und anschließend durch ihre Werte zu ersetzen.
Ich hab deine Prozedur mal in diese Richtung angepasst. Dabei ist es Geschmackssache, ob man die Formeln so extrem per Formel "zusammenbastelt" oder die Formeln weitestgehen übernimmt wie mit dem Recorder aufgezeichnet und sich auf notwendige Anpassungen für Zeilen/Spalten beschränkt.
Auf alle Fälle sollte zur Beschleunigung der Makroausführung auch die Bildschirmaktualisierung vorübergehend deaktiviert werden.
Gruß
Franz
Sub Eintragen()
Dim cD1 As String, cD2 As String, cD3 As String, cD4 As String, cD5 As String, cD6 As _
String, cD7 As String, cD8 As String
Dim startDate As Date, endDate As Date
Dim aSheet As Worksheet
Dim zNr As Long, zLast As Long, sNr As Long, sFormel
Dim xS As String, xL As String, T As String
Set aSheet = ThisWorkbook.Sheets("Auswertung")
With aSheet
cD1 = "xDatum"
cD2 = "xKonto"
cD3 = "xSoll"
cD4 = "xHaben"
cD5 = "xGegKonto"
cD6 = "xBuText"
xS = "SumProduct"
xL = "Left"
T = aSheet.Name
zNr = 26
Worksheets(aSheet.Name).Activate
'Letzte Datenzeile
zLast = .Cells(.Rows.Count, 1).End(xlUp).Row
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Variante 1 - Formeln im Code per Formel zusammengestellt.
''''''''SUMMENPRODUKT((xDatum=$A26)*(xKonto=C$23)*(LINKS(xGegKonto;3)="102")*xSoll)
sNr = 3 'Spalte C berechnen - Formeln im Code in R1C1-Schreibweise
sFormel = "=" & xS & "((" & cD1 & "=" & T & "!R[0]C1)*(" & cD2 & "=" & T _
& "!R23C" & sNr & " )*(" & xL & "(" & cD5 & ",3)=" & """102""" & " )*" & cD3 & ")"
With .Range(.Cells(zNr, sNr), .Cells(zLast, sNr))
.FormulaR1C1 = sFormel
.Calculate
.Value = .Value
End With
'' Gebühren aus Verkauf werden aus Kaufspalte eliminiert und mit Verkaufsspalte verrechnet
''''''''SUMMENPRODUKT((xDatum=$A31)*(xKonto=C$23)*(LINKS(xBuText;10)="VGebuehren")*(LINKS( _
xGegKonto;3)="102")*xSoll)
'Werte in Hilfsspalte (90) berechenen
sFormel = "=R[0]C" & sNr & " - " & xS & "((" & cD1 & "=" & T & "!R[0]C1)*(" & cD2 & "=" _
& T & "!R23C" & sNr & ")*(" & xL & "(" & cD6 & ",10)=" & """VGebuehren""" _
& " )*(" & xL & "(" & cD5 & ",3)=" & """102""" & " )*" & cD3 & ")"
With .Range(.Cells(zNr, 90), .Cells(zLast, 90))
.FormulaR1C1 = sFormel
.Calculate
.Value = .Value
'Werte nach Spalte kopieren
.Copy Destination:=aSheet.Range(aSheet.Cells(zNr, sNr), aSheet.Cells(zLast, sNr))
'Hilfsspalte wieder löschen
.Clear
End With
GoTo Weiter01
'Variante 2 - Formeln dierekt im Code geschrieben
sNr = 3 'Spalte C berechnen
sFormel = "=SUMPRODUCT((xDatum=R[0]C1)*(xKonto=R23C" & sNr _
& ")*(LEFT(xGegKonto,3)=""102"")*xSoll)"
With .Range(.Cells(zNr, sNr), .Cells(zLast, sNr))
.FormulaR1C1 = sFormel
.Calculate
.Value = .Value
End With
'Berechnung in Hilfsspalte 90
sFormel = "=R[0]C" & sNr & " - SUMPRODUCT((xDatum=R[0]C1)*(xKonto=R23C" & sNr _
& ")*(LEFT(xBuText,10)=""VGebuehren"")*(LEFT(xGegKonto,3)=""102"")*xSoll)"
With .Range(.Cells(zNr, 90), .Cells(zLast, 90))
.FormulaR1C1 = sFormel
.Calculate
.Value = .Value
'Werte aus Hilfsspalte nach Spalte kopieren
.Copy Destination:=aSheet.Range(aSheet.Cells(zNr, sNr), aSheet.Cells(zLast, sNr))
'Hilfsspalte wieder löschen
.Clear
End With
End With
Weiter01:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub