In meiner täglichen Arbeit mit Excel und VBA stieß ich auf ein häufiges Problem: Wie summiere ich eine Liste von Zahlen effizient, ohne Duplikate zu berücksichtigen? Oftmals findet man in Datensätzen Wiederholungen von Zahlen, und die Herausforderung besteht darin, jede Zahl nur einmal in die Endsumme einfließen zu lassen. Dieser Artikel zeigt, wie man diese Aufgabe sowohl mit einer Matrixformel als auch mit VBA löst.

Ausgangslage

Ausgangslage ist eine Liste von Zahlen, in der bestimmte Zahlen doppelt vorkommen:

Und es soll nur jede Zahl einmal in die Summe einbezogen werden: (Für das konkrete Beispiel also folgendes:)

Aber wie geht das schneller?

Lösung mittels Matrixformel

Mithilfe einer Matrixformel: 

{=SUMME(WENN(ISTZAHL(Bereich);1/ZÄHLENWENN(Bereich;Bereich)*Bereich))}

Achtung: mit StrG + Umschalt + Enter abschließen!

Da die Formel aber nicht wirklich leicht zu merken ist, analysiere ich mal die Formel:

1. Mit {=ZählenWenn(Bereich;Bereich)} wird ermittelt, wie oft die jeweilige Zahl vorkommt

2. mit {=1/Zählenwenn(Bereich;Bereich)} wird sozusagen jede Zahl gewichtet, je nach Anzahl der Vorkommen

3. mit {=1/Zählenwenn(Bereich:Bereich)*Bereich)} wird die gewichtete Zahl mit ihrem Wert multipliziert.

Zur Verdeutlichung:

Am Beispiel der Zahl 7 möchte ich das ganze noch mal erklären.

Die Zahl kommt 3 mal vor (=ZÄHLENWENN(Bereich;7)). Das bedeutet, jede dieser Zahlen hat eine Gewichtung von 1/3 =0,3333 (=1/ZÄHLENWENN(Bereich;7)). Das heißt jedes der 3 mal vorkommenden Zahl 7 trägt zur Summe 2,33333 bei (=1/ZÄHLENWENN(Bereich;7)*7).

Das Problem dabei ist, dass man sich die Formel nicht merkt und die Herleitung doch etwas Denkarbeit erfordert. Daher habe ich auch eine VBA Lösung entwickelt. 

Lösung mittels VBA (Formel)

Public Function SummeOhneDuplikate(myRange As Range) As Double
Dim AddressRange As String
AddressRange = myRange.Address
' Bewertet jede Zahl in der Range basierend auf ihrer Häufigkeit
' und summiert diese Bewertungen auf, um die Summe ohne Duplikate zu erhalten
SummeOhneDuplikate = Application.Evaluate("=SUM(IF(ISNUMBER(" & AddressRange & "),1/COUNTIF(" & AddressRange & "," & AddressRange & ")*" & AddressRange & "))")
End Function

Die Funktion SummeOhneDuplikate nimmt einen Zellenbereich (myRange) als Eingabe und gibt die Summe der einzigartigen Zahlen in diesem Bereich zurück. Der Code nutzt eine Array-Formel innerhalb von VBA, um zuerst zu überprüfen, ob ein Wert eine Zahl ist (ISNUMBER), zählt dann, wie oft jede Zahl vorkommt (COUNTIF), und bildet schließlich die Summe dieser einzigartigen Zahlen.

Lösung mittels VBA (Collection)

Eine alternative VBA-Methode ist die Verwendung von Collections. Collections sind eine einfache Möglichkeit, Duplikate zu vermeiden, da sie automatisch verhindern, dass dieselben Elemente mehrfach hinzugefügt werden.

Public Function SummeMitCollection(rng As Range) As Double
Dim cell As Range
Dim col As New Collection
Dim summe As Double
summe = 0
' Versuche, jede Zahl in die Collection einzufügen. Duplikate werden ignoriert.
On Error Resume Next
For Each cell In rng
If IsNumeric(cell.Value) Then
col.Add cell.Value, CStr(cell.Value)
End If
Next cell
On Error GoTo 0
' Summiere die einzigartigen Werte.
For Each cell In col
summe = summe + cell
Next cell
SummeMitCollection = summe
End Function

Funktionsweise:

  1. Initialisierung: Eine neue Collection wird erstellt, und die Summe wird auf 0 gesetzt.
  2. Hinzufügen von Werten: Für jede Zelle in der übergebenen Range rng wird überprüft, ob der Wert numerisch ist. Wenn ja, wird er zur Collection hinzugeefügt. Da Collections keine Duplikate des gleichen Schlüssels zulassen, werden automatisch nur einzigartige Werte gespeichert.
  3. Summierung: Alle einzigartigen Werte in der Collection werden summiert.

Lösung mittels VBA (Dictionary)

Public Function SummeMitDictionary(rng As Range) As Double
Dim cell As Range
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim summe As Double
summe = 0
' Füge jede Zahl als Schlüssel im Dictionary hinzu.
For Each cell In rng
If IsNumeric(cell.Value) Then
dict(cell.Value) = 1 ' Der Wert ist irrelevant, es geht um den Schlüssel.
End If
Next cell
' Summiere die Schlüssel (einzigartige Zahlen).
For Each key In dict.Keys
summe = summe + key
Next key
SummeMitDictionary = summe
End Function

Funktionsweise:

  1. Initialisierung: Ein Dictionary-Objekt wird erstellt, und die Summe wird auf 0 gesetzt.
  2. Hinzufügen von Werten: Für jede Zelle in rng wird, sofern sie eine Zahl enthält, dieser Wert als Schlüssel zum Dictionary hinzugefügt. Da ein Dictionary keine Duplikate zulässt, werden nur einzigartige Werte behalten.
  3. Summierung: Die Schlüssel des Dictionaries, welche die einzigartigen Zahlen darstellen, werden summiert.