Nun habe ich mir gedacht mit einer WorksheetFunction = SumProduct geht dies besser und schneller aber leider gibt es immer einen Fehler "Laufzeitfehler 13" Typen unverträglich, hier meine Codezeile:
16.04.2026, 11:36 (Dieser Beitrag wurde zuletzt bearbeitet: 16.04.2026, 11:57 von slowboarder.)
Hi das Problem sollten nicht Texte sein, denn sonst würde auch das erste nicht funktionieren. das Problem ist, dass eine VBA-Berechnungszeile keine Matrixformeln berechnen kann. mit Evaluate funktioniert es, weil Evaluate quasi eine Excelzelle ist, VBA kann die notwendige Schleife nicht automatisch erstellen und du müsstest hier selber die For-Next-Scheife über alle Zellen programmieren. Schneller wird es nur, wenn du eine Methode findest, die besser rechnet als die Excelfunktion.
btw, wie lange dauert denn die Berechnung, wenn du die Formel in einer Zelle ausführst? wie viele Zeilen hat die Tabelle (Spalten sind des ja 240)
For z = 1 To UBound(einA, 1) If einA(z, 1) = vgwA Then If einI(z, 1) = vgwI Then For s = 1 To UBound(einZ1, 2) If einZ1(1, s) = vgwZ1 Then varAlles(intAz, intAa - 2) = varAlles(intAz, intAa - 2) + einDat(z, s) End If Next End If End If Next
wenn von den vielen Spalten immer nur genau eine zutreffen kann und nicht mehrere, dann wäre es sinnvoll, zunächst einmal diese Spaltennummer zu ermitteln, dann kannst du die Berechnung auch einfacher mit SummeWenns (Worksheetfunction.CountIf) machen.
vielleicht wäre es auch möglich, zuerst die Daten mit der FILTER-Funktion auf die notwendigen zu reduzieren und dann einfach die Summe zu bilden.
(16.04.2026, 11:36)slowboarder schrieb: vielleicht wäre es auch möglich, zuerst die Daten mit der FILTER-Funktion auf die notwendigen zu reduzieren und dann einfach die Summe zu bilden.
Hallo Daniel,
Ein sehr sehr gutes Codebeispiel!
Meiner Erfahrung nach unterschätzt man meist die Ausführungsgeschwindigkeit von Arrays, das wird so schnell laufen das eine Variante mit FILTER eher länger dauert.
Die Anzahl an Zeilen kann variieren. Kleiner Nachtrag in beiden Tabellen in der ersten Zeile befinden sich Uhrzeiten Beginnend ab 04:00 Uhr in Fünfminutentakt bis 23:55 Uhr, in Einreise wird dann für den jeweiligen Tag -> Position und Uhrzeit die Summe gebildet.
Zeit Tabellenblatt Einreise von L1:IQ1 und Einreise_Position C1:IH1.
Code:
Sub Position_E() Dim varTage As Variant Dim varPos As Variant Dim varAlles As Variant Dim lngLetzte As Long Dim intI As Integer Dim intAz As Integer Dim intAa As Integer Dim blnAus As Byte lngLetzte = Worksheets("Einreise").Cells(Rows.Count, 2).End(xlUp).Row 'Wochentage kommen mehrfach in Einreise vor varTage = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag") ReDim varPos(lngLetzte) 'Positionen einzeln aufführen da sie mehrfach vorkommen For intI = 2 To lngLetzte If Application.WorksheetFunction.CountIf(Range(Worksheets("Einreise").Cells(intI, 9), Worksheets("Einreise").Cells(2, 9)), Worksheets("Einreise").Cells(intI, 9).Value) = 1 Then varPos(intAz) = Worksheets("Einreise").Cells(intI, 9).Value intAz = intAz + 1 End If Next intI ReDim Preserve varPos(intAz - 1)
ReDim varAlles(UBound(varPos), 239) blnAus = 2 For intI = 0 To UBound(varTage) For intAz = 0 To UBound(varPos) For intAa = 2 To 241 varAlles(intAz, intAa - 2) = Evaluate("=SUMPRODUCT(('Einreise'!A2:A" & lngLetzte & "=""" & varTage(intI) & """)*('Einreise'!I2:I" & lngLetzte & "=""" & varPos(intAz) & """)*('Einreise'!L1:IQ1='Einreise_Position'!" & Worksheets("Einreise_Position").Cells(1, intAa + 1).AddressLocal & ")*('Einreise'!L2:IQ" & lngLetzte & "))") Next intAa Next intAz 'Ausgabe Wochentag Worksheets("Einreise_Position").Cells(blnAus, 1) = varTage(intI) 'Ausgabe der Positionen für den Wochentag Worksheets("Einreise_Position").Range(Cells(blnAus, 2), Cells(blnAus + UBound(varPos), 2)) = WorksheetFunction.Transpose(varPos) 'Ausgabe Summe Wochentag + Position der jeweiligen Uhrzeit Worksheets("Einreise_Position").Range(Cells(blnAus, 3), Cells(blnAus + UBound(varPos), 242)) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(varAlles)) blnAus = blnAus + UBound(varPos) + 2 Next intI End Sub
Da glaube ich das ich ins Detail gehen müsste, wenn ich heute Abend die Zeit finde stelle ich die Datei ein, ist dann vielleicht verständlicher.
Aber hier schon einmal mein Code, hätte ich ja auch schon einstellen können.
Hi solche Auswertungen lassen sich häufig über Dictionaray-Objekt beschleunigen.
du müsstest zu beginn des ganzen erstmal das hier ausführen:
Code:
dim dic as object dim z as long, s as long dim arr dim id as string
set dic = createobject("Scripting.Dictionary")
arr = Worksheets("Einreise").Range("A2:IQ" & lngLetzte).value for z = 2 to ubound(arr, 1) for s = 12 to ubound(arr, 2) id = arr(z, 1) & "|" & arr(z, 9) "|" & arr(1, s) if isnumeric(arr(z, s)) then dic(id) = dic(id) + arr(z, s) next next
das führst du zu beginn einmalig aus
in der Auswertung kannst du dann die Werte aus der Variable dic auslesen das geht schneller, als jedesmal über alle Quelldaten zu schleifen.
16.04.2026, 22:12 (Dieser Beitrag wurde zuletzt bearbeitet: 16.04.2026, 22:24 von slowboarder.)
Hi bevor du dich mit neuen komplexen Sachen beschäftigen musst: die Spaltenzuordnung ist doch 1:1, dh du musst die Spalte gar nicht suchen sondern kannst diese direkt aus der Spalte ausrechnen. gesucht werden muss dann nur noch die Zeile
das ist dann um Faktor 240 (entsprechend der Spalten die du hast) schneller als dein Summenprodukt, weil eben die Schleife zum Suchen der richtigen Spalte entfällt. Die Suche ist hier nicht notwendig, weil in beiden Tabellen die Spalten exakt gleich sind.
du müsstest nur in der Spalte A von Einreise_Position die Wochentage auch nach unten ausfüllen (ansonsten würde die Formel wieder komplizierter) für die Optik kannst du die Werte ja über das Zahlenformat ausblenden (Bereich: ab A2, Regel: =A2=A1 und benutzerdefiniertes Zahlenformat: ;;;
das sollte eigentlich ausreichen, die Sache genügend schnell zu machen.
sie es mal so: du hast 111*240 Formeln. mit der Summenproduktformel muss jede dieser Formeln jede Zelle der daten Quelle abklappern und diese hat 256*240 Zellen. macht also einen gesamtaufwand von 111*240*256*240 wenn du aber die Spalte direkt angibst (was hier möglich ist), dann muss jeder Formel nur noch diese Spalte durchsuchen, also 256 Zellen macht also den Gesamtaufwand von 111*240*256
hätte auch den Charme, dass du diese Formel in VBA über Worksheetfunction nachprogrammieren kannst, weil es keine Matrixformel ist.
Gruß Daniel solltest du mal den Fall haben, dass die Spalten nicht 1:1 übereinstimmen, sondern über die Überschriften gesucht werden, aber die Überschriften immer noch eindeutig sind (also nur 1x vorkommen), dann auch so:
das zeitaufwendige Summenprodukt benötigst du nur, wenn die Werte auch über mehrere Spalten aggregiert werden müssen, dh in der Quelle eine Spaltenüberschrift mehrfach vorkommen kann.
16.04.2026, 22:40 (Dieser Beitrag wurde zuletzt bearbeitet: 16.04.2026, 22:40 von Kay1909.)
Hallo Daniel,
erstmal die Antwort auf dein Dictinaray.
Das ist krass jetzt nur noch ein Wimpernschlag an Zeit, aber ich musste dies noch etwas anpassen.
id = arr(z, 1) & "|" & arr(z, 9) & "|" & arr(1, s) hier fehlte nach arr(z,9) das &
Den Bereich für den Inhalt des arr, die Zeile 1 aus Einreise mit übertragen -> arr = Worksheets("Einreise").Range("A1:IQ" & lngLetzte).Value
Diese Schleifen musste ich Tauschen, erst die Zeilen durchlaufen, dann die Spalte um ein erhöhen usw.
For z = 2 To UBound(arr, 1) For s = 12 To UBound(arr, 2)
in
For s = 12 To UBound(arr, 2) For z = 2 To UBound(arr, 1)
Nur wie das mit Dictinaray funktioniert habe ich überhaupt nicht verstanden
Hier mein jetziger gesamte Code der hervorragend funktioniert:
Code:
Sub Position_E() Dim varTage As Variant Dim varPos As Variant Dim varAlles As Variant Dim lngLetzte As Long Dim intI As Integer Dim intAz As Integer Dim intAa As Integer Dim blnAus As Byte Dim dic As Object Dim z As Long, s As Long Dim arr Dim id As String
Set dic = CreateObject("Scripting.Dictionary") lngLetzte = Worksheets("Einreise").Cells(Rows.Count, 2).End(xlUp).Row
'Code Daniel Dictonarie arr = Worksheets("Einreise").Range("A1:IQ" & lngLetzte).Value For s = 12 To UBound(arr, 2) For z = 2 To UBound(arr, 1) id = arr(z, 1) & "|" & arr(z, 9) & "|" & arr(1, s) If IsNumeric(arr(z, s)) Then dic(id) = dic(id) + arr(z, s) Next Next
'Wochentage kommen mehrfach in Einreise vor varTage = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag") ReDim varPos(lngLetzte) 'Positionen einzeln aufführen da sie mehrfach vorkommen For intI = 2 To lngLetzte If Application.WorksheetFunction.CountIf(Range(Worksheets("Einreise").Cells(intI, 9), Worksheets("Einreise").Cells(2, 9)), Worksheets("Einreise").Cells(intI, 9).Value) = 1 Then varPos(intAz) = Worksheets("Einreise").Cells(intI, 9).Value intAz = intAz + 1 End If Next intI ReDim Preserve varPos(intAz - 1)
ReDim varAlles(UBound(varPos), 239) blnAus = 2 For intI = 0 To UBound(varTage) For intAz = 0 To UBound(varPos) For intAa = 2 To 241 id = varTage(intI) & "|" & varPos(intAz) & "|" & Worksheets("Einreise_Position").Cells(1, intAa + 1) varAlles(intAz, intAa - 2) = dic(id) Next intAa Next intAz 'Ausgabe Wochentag Worksheets("Einreise_Position").Cells(blnAus, 1) = varTage(intI) 'Ausgabe der Positionen für den Wochentag Worksheets("Einreise_Position").Range(Cells(blnAus, 2), Cells(blnAus + UBound(varPos), 2)) = WorksheetFunction.Transpose(varPos) 'Ausgabe Summe Wochentag + Position der jeweiligen Uhrzeit Worksheets("Einreise_Position").Range(Cells(blnAus, 3), Cells(blnAus + UBound(varPos), 242)) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(varAlles)) blnAus = blnAus + UBound(varPos) + 2 Next intI End Sub
Mit der Formel werde ich mich auch noch beschäftigen, aber da habe ich immer so meine Probleme werde mich damit auch noch beschäftigen.
Hi sagen wir mal so: dafür das ich keine Datei zum testen hatte, und den Code einfach so hingeschrieben habe, sind da doch wenig Fehler drin! so anpassungen nach dem ersten schreiben sind normal, dass musst du nicht extra erwähnen
zum Verständis.
ein Dictionary ist im Prinzip ein eindimensionales Array, bei dem der Index nicht über eine feste Zahlenfolge, sondern über einen Freitext gebildet wird. Über diesen Freitext-Index kann man dann sehr schnell auf die im Dictionary gespeicherten Inhalte zu greifen. (wie das jetzt genau intern abläuft, kann ich dir nicht sagen, aber es funktioniert sehr gut)
Folgende(r) 1 Nutzer sagt Danke an slowboarder für diesen Beitrag:1 Nutzer sagt Danke an slowboarder für diesen Beitrag 28 • Kay1909
VBA Evaluate(=SUMPRODUCT.. in WorksheetFunction.SumProduct... ändern
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
