Kombinationen aufsummieren

[joshua]

Hallo Community!
Ich habe zum nachstehend beschriebenen Problem bereits einen Thread eröffnet. (http://www.clever-excel-forum.de/thread-9230.html)
Ich eröffne nun einen komplett neuen, da sich die Struktur und die Anforderung teils geändert haben.
Am Ende poste ich jedoch zwei Codes, die hilfreich sein könnten.

Ziel ist es, Kombinationen aus zwei bzw. drei Spalten/ Zahlen in einer Matrix aufzusummieren.
Hier ist einmal die Tabelle.
[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]
In die erste Matrix, soll die Kombination aus Spalte G und I eingetragen werden, in der zweiten Matrix die Kombination aus Spalte A und Q.

[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]
Pro Klasse (Spalte E), soll jeweils nur eine Kombination aus A und B1 und A und B2 in die entsprechende Matrix aufsummiert werden.

Folgendes ist hierbei zu beachten:
Besitzt eine Klasse, mehr als eine Zeile, so soll nur jeweils die höchste Kombination eingetragen werden.
Besitzt eine Zeile keine Einträge in J:S, so soll diese überhaupt nicht beachtet werden.



Hier einmal die Vorschläge von snb und atilla:

Code:

Sub M_snb()
   sn = Sheet1.Cells(1, 2).CurrentRegion.Resize(, 10)

   Sheet2.Range("C4:G8").ClearContents
   sp = Sheet2.Range("C4:G8")
   sq = sp
   
   For j = 2 To UBound(sn)
      If sn(j, 1) <> sn(1, 2) Then
         If sn(1, 5) <> "" Then
           sp(sn(1, 5), sn(1, 6)) = sp(sn(1, 5), sn(1, 6))+1
           sq(sn(1, 5), sn(1, 7)) = sq(sn(1, 5), sn(1, 7))+1
         End If
         sn(1, 2) = sn(j, 1)
         sn(1, 5) = sn(j, 3)
         sn(1, 6) = sn(j, 4)
         sn(1, 7) = sn(j, 9)
      Else
         If sn(j, 4) > sn(1, 6) Then sn(1, 6) = sn(j, 4)
         If sn(j, 9) > sn(1, 7) Then sn(1, 7) = sn(j, 9)
      End If
   Next
   sp(sn(1, 5), sn(1, 6)) =  sp(sn(1, 5), sn(1, 6))+1
   sq(sn(1, 5), sn(1, 7)) = sq(sn(1, 5), sn(1, 7))+1
   
   Sheet2.Range("C4:G8") = sp
   Sheet2.Range("J4:N8") = sq
End Sub

Code:

Sub ati_mach()
 Dim i As Long
 Dim gesBereich, b1Bereich, b2Bereich

 Dim b1vonD1, b2vonD2
 Dim varKA
 Dim D1 As Object, D1A As Object
 Dim D2 As Object, D2A As Object
 
 Set D1 = CreateObject("Scripting.Dictionary")
 Set D1A = CreateObject("Scripting.Dictionary")
 Set D2 = CreateObject("Scripting.Dictionary")
 Set D2A = CreateObject("Scripting.Dictionary")
 gesBereich = Sheets("Tabelle1").Range("B2:J30")

 For i = 1 To UBound(gesBereich)
   varKA = gesBereich(i, 1)
   If gesBereich(i, 1) = varKA Then
     If CDbl(gesBereich(i, 3) & gesBereich(i, 4)) > D1(varKA) Then
       D1(varKA) = CDbl(gesBereich(i, 3) & gesBereich(i, 4))
       D1A(varKA) = gesBereich(i, 3) & " " & gesBereich(i, 4)
     End If
   
     If CDbl(gesBereich(i, 3) & gesBereich(i, 9)) > D2(varKA) Then
       D2(varKA) = CDbl(gesBereich(i, 3) & gesBereich(i, 9))
       D2A(varKA) = gesBereich(i, 3) & " " & gesBereich(i, 9)
     End If
   End If
 Next i
   

 With Sheets("Tabelle2").Range("C4:G8")
   .ClearContents
    b1Bereich = .Value
   For Each varKA In D2A.keys
      b1Bereich(Split(D1A(varKA))(0), Split(D1A(varKA))(1)) = b1Bereich(Split(D1A(varKA))(0), Split(D1A(varKA))(1)) + 1
   Next
   .Value = b1Bereich
 End With
 
 If Application.Count(Application.Index(Application.Transpose(gesBereich), 9)) > 0 Then
   With Sheets("Tabelle2").Range("J4:N8")
     .ClearContents
      b2Bereich = .Value
     For Each varKA In D2A.keys
        b2Bereich(Split(D2A(varKA))(0), Split(D2A(varKA))(1)) = b2Bereich(Split(D2A(varKA))(0), Split(D2A(varKA))(1)) + 1
     Next
     .Value = b2Bereich
   End With
 End If
End Sub

Beste Grüße
Joshua

[schauan]

Hallöchen,

wäre auch eine Formellösung möglich? So ist erst mal die "Hälfte" erfüllt. Formel oben links eintragen und in die anderen Zellen kopieren. Fehlt dann noch der Teil mit nur der höchsten ...

Arbeitsblatt mit dem Namen 'tblMatrix'
	B	C	D	E	F	G	H
4		Pre
5	B1	5	0	0	0	0	0
6		4	0	0	0	0	0
7		3	0	0	3	1	0
8		2	0	0	2	2	0
9		1	0	0	2	0	0
10			1	2	3	4	5
11		A

Zelle	Formel
D5	=SUMMENPRODUKT((tblSummary!$I$2:$I$11=$C5)*(tblSummary!$G$2:$G$11=D$10))

Diese Tabelle wurde mit Tab2Html (v2.5.0) erstellt. ©Gerd alias Bamberg

[joshua]

Hallöchen,

wäre auch eine Formellösung möglich? So ist erst mal die "Hälfte" erfüllt. Formel oben links eintragen und in die anderen Zellen kopieren. Fehlt dann noch der Teil mit nur der höchsten ...

Arbeitsblatt mit dem Namen 'tblMatrix'
	B	C	D	E	F	G	H
4		Pre
5	B1	5	0	0	0	0	0
6		4	0	0	0	0	0
7		3	0	0	3	1	0
8		2	0	0	2	2	0
9		1	0	0	2	0	0
10			1	2	3	4	5
11		A

Zelle	Formel
D5	=SUMMENPRODUKT((tblSummary!$I$2:$I$11=$C5)*(tblSummary!$G$2:$G$11=D$10))

Diese Tabelle wurde mit Tab2Html (v2.5.0) erstellt. ©Gerd alias Bamberg

Hallo schauan, vielen Dank für deinen Ansatz.

eine Formellösung ist auch wunderbar.

Tendiere momentan jedoch immer gerne zu VBA, da ich mich gerade dadrin versuche und dadurch immer tiefereEinblicke erhalte (:

[joshua]

Hallo Leute!

Ich hoffe ich habe alle notwendigen Informationen und Dokumente zur Verfügung gestellt.
Leider bin ich immer noch nicht weitergekommen.
In meinem Buch bin ich auf die Select-Case Variante gestoßen.
Vielleicht wäre dies ein möglicher Ansatz?

Weiterhin habe ich hier ein Flussdiagramm erstellt, welches die Logik vielleicht ein wenig besser darstellt.
[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]

Ich freue mich wirklich über jeden Beitrag (: