Ich hoffe ich habe das richtig verstanden:
Spalte A: Alle Tel.nr unsortiert, der Reihe nach
Spalte B: Zu der Tel.nr in A gehörender Betrag
Spalte C: Nummern von Anton, einzeln, ohne dass eine mehrfach vorkommt.
Spalte D: Für Zwischensummen, zunächst frei, wird mit der Summe der Beträge aus B befüllt, die zu der Tel.nr in A passt
Spalte E: Bertas Nummern, analog Spalte C.
Spalte F: Für Bertas Zwischensummen, analog Sp. D
Spalte G: Cäsars Nummern
Spalte H: Cäsars Zwischensummen
Spalte I: Frei für übrige Nummern, die keiner für sich notiert hat.
Das lässt sich am besten mit einem Makro lösen. Wenn du Hilfe beim Erstellen von Makros brauchst oder keine Makro-Antwort willst (kommt öfter vor) schreib das in die Frage.
Ich will nicht behaupten, dass Dein Problem nicht ohne Makro lösbar ist, jedoch nicht für mich (habe es versucht). Meine Kenntnisse reichen nicht so weit.
In die Makros müssen die Werte für Nummern und AnName angepasst werden.
Sub SuchenUndAddieren()
’ Die Tel.Nummern stehen in A, die Beträge in B
’ Hier drin werden die Beträge aufsummiert
BetrAnton@ = 0
BetrBerta@ = 0
BetrCaesar@ = 0
’ Nummern ist die Spaltennummer der letzten Tel.Nr.
’ AnzName ist die Anzahl der Tel.Nr. die die jeweilige Person einträgt
Nummern% = 22
AnzAnton% = 5
AnzBerta% = 5
AnzCaesar% = 5
For J = 1 To AnzAnton
aktNr@ = 0 ’ optional
For I = 1 To Nummern
If Range(„C“ & J).Text = Range(„A“ & I).Text Then
BetrAnton = BetrAnton + Range(„B“ & I).Text
aktNr = aktNr + Range(„B“ & I).Text ’ optional
End If
Next
Range(„D“ & J).Select ’ optional
ActiveCell = aktNr ’ optional
Next
Range(„D“ & AnzAnton + 1).Select
ActiveCell = BetrAnton
For J = 1 To AnzBerta
aktNr = 0 ’ optional
For I = 1 To Nummern
If Range(„E“ & J).Text = Range(„A“ & I).Text Then
BetrBerta = BetrBerta + Range(„B“ & I).Text
aktNr = aktNr + Range(„B“ & I).Text ’ optional
End If
Next
Range(„F“ & J).Select ’ optional
ActiveCell = aktNr ’ optional
Next
Range(„F“ & AnzAnton + 1).Select
ActiveCell = BetrAnton
For J = 1 To AnzCaesar
aktNr = 0 ’ optional
For I = 1 To Nummern
If Range(„G“ & J).Text = Range(„A“ & I).Text Then
BetrCaesar = BetrCaesar + Range(„B“ & I).Text
aktNr = aktNr + Range(„B“ & I).Text ’ optional
End If
Next
Range(„H“ & J).Select ’ optional
ActiveCell = aktNr ’ optional
Next
Range(„H“ & AnzAnton + 1).Select
ActiveCell = BetrAnton
’ OPTIONAL: Entweder alle oder keine! (Trägt Zwischensummen ein)
’ HINWEIS: Jede Nummer in C, E und G muss exklusiv/persönlich sein
’ und darf nur einmal in der Liste stehen. Ansonsten kommt es zu
’ mehrfacher Berechnung.
End Sub
Ausführen und fertig:
Wenn optionales stehengelassen:
Sp A, B, C, E und G unverändert
Sp D: Zwischensummen, ganz unten Summe für Anton
Sp F: Zwischensummen, ganz unten Summe für Berta
Sp H: Zwischensummen, ganz unten Summe für Cäsar
ohne optionales keine Zwischensummen.
Die nicht zugeteilten Nummern finden:
Sub NamenloseFinden()
’ Nummern ist die Spaltennummer der letzten Tel.Nr.
’ AnzName ist die Anzahl der Tel.Nr. die die jeweilige Person einträgt
Nummern% = 22
AnzAnton% = 5
AnzBerta% = 5
AnzCaesar% = 5
K = 1
For I = 1 To Nummern
InAnton = False
InBerta = False
InCaesar = False
For J = 1 To AnzAnton
If Range(„C“ & J).Text = Range(„A“ & I).Text Then
InAnton = True
End If
Next
For J = 1 To AnzBerta
If Range(„E“ & J).Text = Range(„A“ & I).Text Then
InBerta = True
End If
Next
For J = 1 To AnzCaesar
If Range(„G“ & J).Text = Range(„A“ & I).Text Then
InCaesar = True
End If
Next
If InAnton = False And InBerta = False And InCaesar = False Then
Range(„I“ & K).Select
ActiveCell = Range(„A“ & I).Text
End If
Next
End Sub
Spalte I: nicht zugeteilte aufgelistet ohne Beträge.
Hoffe ich konnte helfen. Die Makros habe ich natürlich getestet, dennoch können sie Fehler enthalten, also doch ein-zwei (zwischen-)Ergebnisse nachrechnen - safety first. Bei Problemen bitte benachrichtigen.
