Thema: Listen zusammenfassen - Daten verschwinden

So,
ich hatte hier zwar den Beitrag schon reingestellt, aber irgendwie taucht er nicht im Forum mehr auf. Daher stelle ich ihn nochmals rein. Falls er doch drin steht, und ich ihn nur übersehen habe, entschuldige ich mich hier schon mal für das Doppelposting! Also dann mal los:
Ich habe hier eine Personenliste, wobei jeder Person eine Firma zugeordnet ist. Es ist auch so, dass mehrere Personen in dieser Liste einer Firma angehören.
Nun möchte ich gerne per Makro, diese Liste nach Firmen zusammenfassen. D.h. in der Liste die dabei rauskommen soll, steht in einer Zelle die Firma und in der selben Zeile eine Zelle weiter stehen nun alle Personen die zu dieser Firma gehören.
Und zwar in diesem Muster: Mustermann, Max; Bolika, Anna; Nachname, Vorname; ....
Dafür habe ich folgendes Makro geschrieben:

Sub test2()
Dim menge, zeile1, zeile2 As Long
Dim ag, namen As String
menge = 1
zeile1 = 1
zeile2 = 1
Do
If Worksheets("Generator").Cells(menge, 1).Value <> "" Then
menge = menge + 1
End If
Loop Until Worksheets("Generator").Cells(menge, 1).Value = ""
Do
ag = Worksheets("Generator").Cells(zeile1, 19).Value
Do
Select Case Worksheets("Test").Cells(zeile2, 3)
Case ag:     namen = Worksheets("test").Cells(zeile2, 1).Value
namen = namen & "; " & Worksheets("Generator").Cells(zeile1, 21). _
Value
Worksheets("test").Cells(zeile2, 1).Value = namen
Case "":     Worksheets("test").Cells(zeile2, 1).Value = Worksheets("Generator"). _
_
_
Cells(zeile1, 21).Value
Worksheets("test").Cells(zeile2, 2).Value = Worksheets("Generator"). _
_
_
Cells(zeile1, 18).Value
Worksheets("test").Cells(zeile2, 3).Value = ag
Worksheets("test").Cells(zeile2, 8).Value = "Unternehmen HH Modell   _
_
_
2008; Unternehmen ALLGEMEIN"
Worksheets("test").Cells(zeile2, 10).Value = Worksheets("Generator") _
_
_
.Cells(zeile1, 23).Value
Case Else:   zeile2 = zeile2 + 1
End Select
Loop Until Worksheets("Test").Cells(zeile2, 3) = ag Or Worksheets("Test").Cells(zeile2,  _
_
_
3) = ""
zeile1 = zeile1 + 1
Loop Until zeile1 > menge
End Sub

Wenn ich nun dieses Makro ausführere erstellt er auch eine Liste, nur ist diese Liste fehlerhaft. Folgende Fehler treten auf:
1. Es werden zwar die Personen den Firmen wie gewünscht zu geordnet, aber nicht alle. Es taucht manchmal die selbe Firma nochmals auf nur mit anderen Personen.
2. Es fehlen ganze Firmen (plus Personen dazu).
3. Bei den zusammen gefassten Einträgen, stehen zwar die Personen drin, aber es fehlt dann immer eine Persom (die erste die hätte eingetragen werden müssen). Die Perso taucht dann auch nicht mehr im ganzen Datensatz auf.
Hat jemand vielleicht 'ne Ahung was da schief läuft. Mir ist bewußt das dieses jetzt alles vielleicht etwas kompliziert rüber kommt, aber wer 'ne Idee hat, kann sie gerne an mich weitergeben. Ich würde mich sehr darüber freuen!
MfG
Gordon

Hallo Gordon,
kannst Du nich eine Beispielmappe hochladen? Würde bei uns viel geringeren Aufwand ergeben.
Gruß Armin

Hatte ich mir schon gedacht, dass das besser wäre.
Musste aber vorher erst die Liste bearbeiten, da das teilweise persönliche Daten beinhaltet. Hab die Liste nun soweit abgeändert, dass man damit arbeiten kann ohne das der Datenschutz in Gefahr ist.
Die Datei findest du hier: https://www.herber.de/bbs/user/54034.xls
Zur Erklärung:
"Generator" ist die Eingangsliste und in "Test" soll die neue Liste entstehen.
Das Makro findest du in Modul1.

Hallo Gordon,
probier das mal:

Option Explicit  ' immer zu empfahlen
Sub test3()
Dim lngG As Long, lngT As Long, strAG As String, strN As String
Dim wksT As Worksheet
Set wksT = Worksheets("Test")
With Worksheets("Generator")
Do While .Cells(lngG + 1, 1) <> ""
lngG = lngG + 1
strAG = .Cells(lngG, 19)
strN = .Cells(lngG, 21)
lngT = lngT + 1
wksT.Cells(lngT, 2) = .Cells(lngG, 18).Value
wksT.Cells(lngT, 3) = strAG
wksT.Cells(lngT, 8) = "Unternehmen HH Modell 2008; Unternehmen ALLGEMEIN"
wksT.Cells(lngT, 10) = .Cells(lngG, 23).Value
Do While strAG = .Cells(lngG + 1, 19) And .Cells(lngG + 1, 1) <> ""
lngG = lngG + 1
strN = strN & "; " & .Cells(lngG, 21)
Loop
wksT.Cells(lngT, 1) = strN
Loop
End With
End Sub

Der Code geht davon aus, dass die Liste nach AG (Spalte S) sortiert ist.
Die Spalten 2 und 10 werden mit den Daten belegt, die in der ersten Zeile des AG stehen.
Noch eine Bemerkung: Mit
Dim ag, namen As String
wird nur namen als String deklariert, ag ist KEIN String, sondern eine Variant-Variable - die Typangabe fehlt.
Man muss also den Typ auch innerhalb einer Zeile hinter jede Variable schreiben.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Danke,
mit dem Makro klappt alles. Warum ging es eigentlich nicht mit meinem Makro? Wo war bei mir der (Denk)Fehler?
Gruß
Gordon

Hallo Gordon,
prima: Dir reicht eine Lösung nicht aus, du willst auch verstehen!
Nur eine Änderung an deinem Code war nötig, damie er läuft. In der Zeile:
Loop Until Worksheets("Test").Cells(zeile2, 3) = ag Or Worksheets("Test").Cells(zeile2, 3) = ""
musst du nur die zweite Bedingung weglassen, also:
Loop Until Worksheets("Test").Cells(zeile2, 3) = ag
Davor wird ja in der Zeile
Case Else: zeile2 = zeile2 + 1
der Zeilenzähler hochgesetzt, solange in der Zeile ein anderer AG steht.
Irgendwann wird der AG gefunden oder die AG-Spalte ist leer - am Ende von "Test".
Und mit der zweiten Bedingung verlässt du dann die Schleife und gehst zum nächsten Satz
aus "Generator", ohne die neue AG-Zeile in Test anzulegen.
Ich habs jetzt nicht getestet, vermute aber, dass dein Code auch bei einem unsortierten "Generator" läuft.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Danke für die Antwort,
leider habe ich meinen Code, da er ja nicht funktionierte, schon entsorgt. Daher fällt das testen leider flach... :(
Dennoch danke.
Gruß
Gordon

Hallo Gordon,
den Ansatz habe ich, aber warscheinlich brauchtst Du noch mehr.
https://www.herber.de/bbs/user/54039.xls
Gruß Armin