Anzahl duplikate zählen

Vati · 1970-01-01T00:00:00+00:00

Guten Morgen zusammen, ich habe mal wieder einen Problemfall. Ich möchte gern aus einer Liste mit 5000 Zeilen Duplikate per Formel zählen. Soweit wäre das kein Problem. Ich muss aber als Suchkriterium immer die Kombination aus Spalte A bis E nehmen und möchte dann in Spalte F nur einmalig die Anzahl stehen haben. Die Daten können auch nicht sortiert werden. Beispiel: Milch Zucker Butter Salz Eier 4 Milch Zucker Butter Salz Eier Milch Milch Milch Milch Milch 3 Milch Zucker Butter Salz Eier Milch Zucker Butter Salz Eier Milch Milch Milch Milch Milch Milch Milch Milch Milch Milch Ist das überhaupt möglich ? Ich probiere schon seit Freitag, finde jedoch keine zufriedenstellende Lösung. V.G. Vati

hallo
Aehnliche Loesung. Formel kopierbar.
Tabellenblattname: Tabelle2

	A	B	C	D	E	F	G
1	milch	zucker	butter	salz	eier	4	milchzuckerbuttersalzeier
2	milch	zucker	butter	salz	eier		milchzuckerbuttersalzeier
3	milch	milch	milch	milch	milch	3	milchmilchmilchmilchmilch
4	milch	zucker	butter	salz	eier		milchzuckerbuttersalzeier
5	milch	zucker	butter	salz	eier		milchzuckerbuttersalzeier
6	milch	milch	milch	milch	milch		milchmilchmilchmilchmilch
7	milch	milch	milch	milch	milch		milchmilchmilchmilchmilch
8	käse	wurst	kaffee	milch	zucker	1	käsewurstkaffeemilchzucker

Benutzte Formeln:
F1: =WENN(ODER(ZÄHLENWENN($G$1:$G1;G1)1;G1="");"";ZÄHLENWENN(G:G;G1))
G1: =A1&B1&C1&D1&E1
gruss hary

Nachtrag:
Da hat noch ein Reset gefehlt ;-)
Gruss
Dirk aus Dubai

Sub Count_Differences()
'This macro count the differences rows and presents the overall count
Dim MyArr As Variant
Dim FirstRow As Long
Dim LastRow As Long
Dim i As Long, k As Long, m As Long
Dim ArrRows As Long
'set first row
FirstRow = 4
'set Lastrow
LastRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
'redim array (0-4 = values, 5=count, 6 = row number)
ReDim MyArr(6, 0)
'loop through Range
For i = FirstRow To LastRow
If ArrRows > 0 Then
'search array for similarities
For k = 0 To ArrRows
For m = 0 To 4
If MyArr(m, k) = Cells(i, m + 1).Value Then
mcount = mcount + 1
Else
mcount = 0
Exit For
End If
Next m
If mcount = 5 Then
'match found, adjust array count
MyArr(5, k) = MyArr(5, k) + 1
Exit For
End If
Next k
'check, if similary was found in array
If mcount = 0 Then
'not found, add array row
For k = 1 To 5
MyArr(k - 1, ArrRows) = Cells(i, k)
Next k
MyArr(k - 1, ArrRows) = 1
MyArr(6, ArrRows) = i
ArrRows = ArrRows + 1
ReDim Preserve MyArr(6, ArrRows)
End If
mcount=0
Else
'first assignment of array
For k = 1 To 5
MyArr(k - 1, 0) = Cells(i, k)
Next k
MyArr(k - 1, 0) = 1
MyArr(6, 0) = i
ArrRows = ArrRows + 1
ReDim Preserve MyArr(6, ArrRows)
End If
Next i
'present results
For i = 0 To ArrRows - 1
Sheets("Sheet1").Cells(MyArr(6, i), 6).Value = MyArr(5, i)
Next i
End Sub

Forumthread: Anzahl duplikate zählen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Duplikate zählen in Excel: So geht's

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)