Microsoft Excel

Herbers Excel/VBA-Archiv

Listen zusammenfassen - Daten verschwinden

Betrifft: Listen zusammenfassen - Daten verschwinden von: Gordon
Geschrieben am: 21.07.2008 18:11:23

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

  

Betrifft: AW: Listen zusammenfassen - Daten verschwinden von: Armin
Geschrieben am: 21.07.2008 18:40:46

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

Gruß Armin


  

Betrifft: AW: Listen zusammenfassen - Daten verschwinden von: Gordon
Geschrieben am: 21.07.2008 19:07:55

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.


  

Betrifft: AW: Listen zusammenfassen - Daten verschwinden von: Erich G.
Geschrieben am: 21.07.2008 19:37:33

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


  

Betrifft: AW: Listen zusammenfassen - Daten verschwinden von: Gordon
Geschrieben am: 22.07.2008 09:34:33

Danke,

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

Gruß
Gordon


  

Betrifft: AW: Danke für Rückmeldung - und ... von: Erich G.
Geschrieben am: 22.07.2008 17:52:18

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


  

Betrifft: AW: Danke für Rückmeldung - und ... von: Gordon
Geschrieben am: 23.07.2008 17:36:54

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


  

Betrifft: AW: Listen zusammenfassen - Daten verschwinden von: Armin
Geschrieben am: 21.07.2008 20:01:33

Hallo Gordon,

den Ansatz habe ich, aber warscheinlich brauchtst Du noch mehr.



https://www.herber.de/bbs/user/54039.xls




Gruß Armin


 

Beiträge aus den Excel-Beispielen zum Thema "Listen zusammenfassen - Daten verschwinden"