Kombinationen zählen

Hallo zusammen,
mache mal einen neuen Beitrag, kann den alten leider nicht reaktivieren:
Es geht um das Zählen von Kombinationen in Aufträgen. Ich stehe vor einem weiteren Problem. Ich habe mal das Makro (von NoNet) durchlaufen lassen, mit 250.000 Datensätzen. Als Ergebnis habe ich ca 3 Mill. Kombinationen erhalten. Nun möchte ich diese Kombinationen zusammen fassen (unabhängig des Auftrags) und deren gesamte Anzahl auflisten. Beispiel:


Artikel 1 - Artikel 2    34 mal
Artikel 2 - Artikel 3    213 mal
Artikel 1 - Artikel 3    69 mal

Das versuche ich derzeit per Pivot, ist aber nur über mehrere Schritte machbar.
Hast jemand vielleicht eine Idee, ob ich das schon während des Auflistens der Kombinationen abfangen kann? Z.B. wenn die Kombination Artikel 1 - Artikel 2 zum ersten Mal auftaucht, könnte die Kombination


Artikel 1 - Artikel 2    1 mal

weggeschrieben werden. Taucht die Kombination erneut auf, wird sie nicht noch einmal weggeschrieben, sondern der Zähler erhöht


Artikel 1 - Artikel 2    2 mal

Bin für eure wertvollen Tipps dankbar!
Beste Grüße,
Peter
https://www.herber.de/bbs/user/76393.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub AuftragsKombisAuflisten() Dim lngZ1 As Long, lngZ2 As Long, lngZ3 As Long Dim lngZA As Long, lngZE As Long, lngZN As Long Dim anfang As Date Dim lngS As Long Dim objKombi As Object Set objKombi = CreateObject("Scripting.Dictionary") Const lngEZ As Long = 4 'Zeile der ersten Kombination lngS = 7 'Ab Spalte 4 eintragen lngZN = lngEZ lngZA = lngZN anfang = Now() For lngZ1 = lngEZ To Cells(Rows.Count, 1).End(xlUp).Row + 1 If Cells(lngZ1 - 1, 1) Cells(lngZ1, 1) And lngZ1 > lngZA Then 'Auftragswechsel For lngZ2 = lngZA To lngZE - 1 For lngZ3 = lngZ2 + 1 To lngZE Cells(lngZN, lngS) = Cells(lngZ2, 1) Cells(lngZN, lngS + 1) = Cells(lngZ2, 2) & " - " & Cells(lngZ3, 2) objKombi(Cells(lngZ2, 2).Value & " - " & Cells(lngZ3, 2).Value) = _ objKombi(Cells(lngZ2, 2).Value & " - " & Cells(lngZ3, 2).Value) + 1 lngZN = lngZN + 1 If lngZN > Rows.Count Then 'Falls Anzahl Zeilen erreicht wurde lngZN = lngEZ 'Zeilenzähler wieder auf Anfangszeile lngS = lngS + 3 '3 Spalten weiter End If Next Next lngZA = lngZ1 Else lngZE = lngZ1 End If Next Cells(lngEZ, lngS + 3).Resize(objKombi.Count) = WorksheetFunction.Transpose(objKombi.keys) Cells(lngEZ, lngS + 4).Resize(objKombi.Count) = WorksheetFunction.Transpose(objKombi.items)

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread