Exel: Text im Falle iener Dopplung zusammenführen

Question

Guten Tag,

ich habe folgendes Problem:

Im Falle einer Dopplung in Spalte Y möchte ich den dazugehörigen Text in Spalte Q in Spalte R zusammenfügen.

Also:

[list]Y2 = 2 Q2 = a
Y3 = 1 Q3 = b
Y4 = 2 Q4 = c
Y5 = 3 Q5 = d[/list]
soll so aussehen:

[list]R2 = a / c
R3 = b
R4 = c
R5 = leer[/list]

Weiß jemand mit einem Makro zu helfen?
Vielen Dank,
lotus

Answer 1

Sorry, Ergebnis muss natürlich heißen:

[/list]R2 = a / c
R3 = b
R4 = leer
R5 = d[/list]

Es können auch mehr als zwei doppelt sein...

Danke,
Lotus

Answer 2

Hallo,

probier es mal so:

Sub zusammen()

Dim z, zaehler, zeile, lzeile As Long
Dim feld()
Dim neu As Boolean

'letzte Zeile in Spalte Y ermitteln
lzeile = ActiveSheet.Cells(Rows.Count, 25).End(xlUp).Row

'Feld neu dimensionieren
ReDim feld(lzeile - 1, 2)

'Schalter für Prüfung auf wahr setzen
neu = True

'Zeilen und Inhalte der Spalten Y und Q in Array einlesen
For zeile = 2 To lzeile

'Prüfen, ob Inhalt der Spalte Y schon im Array vorhanden ist
For z = 0 To zaehler
If feld(z, 1) = Cells(zeile, 25) Then neu = False
Next z

'falls nein, dann Daten in Array aufnehmen
If neu = True Then
zaehler = zaehler + 1
feld(zaehler, 0) = zeile
feld(zaehler, 1) = Cells(zeile, 25)
feld(zaehler, 2) = Cells(zeile, 17)
Else
neu = True 'Schalter wieder auf wahr setzen, falls ein Element schon vorhanden war
End If

Next zeile

'Vergleichen und ggf. Inhalt aus Spalte Q zusammensetzen
For zeile = 2 To lzeile
For z = 1 To zaehler
If Cells(zeile, 25) = feld(z, 1) And zeile > feld(z, 0) Then feld(z, 2) = feld(z, 2) & " / " & Cells(zeile, 17)
Next z
Next zeile

'zusammengesetzten Inhalt in Spalte R schreiben
For z = 1 To zaehler
Cells(feld(z, 0), 18) = feld(z, 2)
Next z

End Sub

Das Makro gehört ein allgemeines Modul.

Gruß

M.O.

Answer 3

Hallo M.O.,

vielen Dank für die Antort. Leider funktioniert es noch nicht ganz so wie es soll. Das Makro fügt zwar irgendwas zusammen, aber nicht das, was es soll. Ich kann die Sortierung nicht wirklich deuten. Nur so viel, es scheint, als ob das Makro teilweise gar nicht die doppelten zusammenfügt, sondern irgendwelche anderen. Auch sind die Texte, die nicht doppelt vorliegen gar nicht übernommen worden. D.h. in Spalte R gibt es entweder gar keinen Text, oder zusammengefügte Texte die aber nicht zusammengehören....hmmm...und nun?

Anmerkung: die Tabelle besteht aus 1100 Zeilen, könnte das ein problem sein?

Verwirrt,
lotus

Answer 4

Hallo Lotus,

mit deinen Beispieldaten funktioniert das Makro entsprechend deinen Vorgaben. An der Menge der Daten kann es eigentlich nicht liegen. Da ich deine Tabelle mit den richtigen Daten nicht kenne, kann ich dazu nicht viel sagen, warum es dort nicht funktioniert.
Du kannst ja mal eine Beispieltabelle mit ein paar Dummy-Daten, die deiner richtigen Tabelle jedoch ähneln, mal hochladen, z.B. hier, und den entsprechenden Download-Link dann hier posten.

Gruß

M.O.

Answer 5

Hallo nochmals,

ich aknn ja mal mein ganzes Problem vorstellen. Ich muss eine Excel Tabelle auswerten und in verschiedenen Blöcken zusammenfassen. Leider kenne ich mich nicht wirklich mit der Erstellung von Makros aus, deshalb meine Frage hier:

Wenn in Spalte AA doppelte Werte vorliegen, sollen die
1.- korrespondierenden Inhalte aus Saplte AC in Spalte Y zusammengefügt werden
2.- korrespondierenden Inhalte aus Saplte Q in Spalte X zusammengeführt werden
3.- korrespondierenden Inhalte aus Saplte I in Spalte W zusammengeführt werden

Für 1-3. gilt: die Duplikate sollen in den Zielspalten (Y,X,W) gelöscht werden. Alle nicht-doppelten Inhalte sollen ebenfalls in die Zielspalten übernommen werden

Insgesamt ist die Tabelle 1100 Zeilen stark.

Hier ein Link zur Tabelle:
Liste.xlsx

Wäre sehr dankbar um Hilfe. Habe durch Unterstützung aus dem Forum die Tabelle zwar schon etwas zähmen können, leider verrutschen immer wieder Informationen, so dass sie falsch ausgegeben werden.

Lotus

Answer 6

Hallo Lotus,

hier der neue Versuch:

Sub zusammen2()

Dim z, zaehler, zeile, lzeile As Long
Dim feld()
Dim neu As Boolean

'letzte Zeile in Spalte AA ermitteln
lzeile = ActiveSheet.Cells(Rows.Count, 27).End(xlUp).Row

'Feld neu dimensionieren
ReDim feld(lzeile - 1, 4)

'Schalter für Prüfung auf wahr setzen
neu = True

'Zeilen und Inhalte der Spalten in Array einlesen
For zeile = 2 To lzeile

'Prüfen, ob Inhalt der Spalte Y schon im Array vorhanden ist
For z = 0 To zaehler
If feld(z, 1) = Cells(zeile, 27) Then neu = False
Next z

'falls nein, dann Daten in Array aufnehmen
If neu = True Then
zaehler = zaehler + 1
feld(zaehler, 0) = zeile
feld(zaehler, 1) = Cells(zeile, 27) 'Spalte AA
feld(zaehler, 2) = Cells(zeile, 29) 'Spalte AC
feld(zaehler, 3) = Cells(zeile, 17) 'Spalte Q
feld(zaehler, 4) = Cells(zeile, 9) 'Spalte I
Else
neu = True 'Schalter wieder auf wahr setzen, falls ein Element schon vorhanden war
End If

Next zeile

'Vergleichen und ggf. Inhalte zusammensetzen
For zeile = 2 To lzeile
For z = 1 To zaehler
If Cells(zeile, 27) = feld(z, 1) And zeile > feld(z, 0) Then
feld(z, 2) = feld(z, 2) & Chr(10) & Cells(zeile, 29)
feld(z, 3) = feld(z, 3) & Chr(10) & Cells(zeile, 17)
feld(z, 4) = feld(z, 4) & Chr(10) & Cells(zeile, 9)
End If
Next z
Next zeile

'Spalten W bis Y löschen
Range(Cells(2, 23), Cells(lzeile, 25)).ClearContents

'zusammengesetzten Inhalt in Spalten schreiben
For z = 1 To zaehler
Cells(feld(z, 0), 25) = feld(z, 2) 'AC in Y
Cells(feld(z, 0), 24) = feld(z, 3) 'Q in X
Cells(feld(z, 0), 23) = feld(z, 4) 'I in W
Next z

End Sub

Gruß

M.O.

Answer 7

Hallo M.O.,

super, genau das ist es! Vielen Dank, du hast mir dadurch seeehr viel Arbeit erspart.

Noch eine kleine Frage:
Wenn ich nun Spalten hinzufüge oder lösche, stimmen die Spaltennummern mit denen das Makro arbeitet nicht mehr - ist das ein Problem, oder übernimmt das Makro automatisch die neuen Spaltennummern?

Danke,
lotus

Answer 8

Hallo Lotus,

du musst im Makro die entsprechenden Spaltennummern anpassen, wenn du Spalten löschst oder einfügst. Daher habe ich auch Kommentare eingefügt :-).

Gruß

M.O.

Answer 9

Ok, dann weiß ich Bescheid, danke!

Jetzt taucht leider noch eine Frage auf:
ich muss den Inhalt filtern. Leider zeigt Excel mir nur bis zu der Spalte mit dem Makro (Y) die Option zu filtern. Alle Spalten, die danach kommen, sind vom Filter ausgenommen. Kann ich was tun, da mir sonst die ganze Tabelle zeschossen wird?

Es hört nicht auf....
lotus

Answer 10

Hallo Lotus,

markiere die erste Zeile und setze dann den Filter. Soweit in der ersten Zeile Überschriften sind, sollte Excel eigentlich erkennen, wie weit die Tabelle geht.

Wenn du die Tabelle bearbeiten willst, dann kopiere doch einfach das Arbeitsblatt. Dann hast du neben der Orginaltabelle, die du unangetastet lässt, noch eine "Arbeitstabelle" mit der du alles mögliche ausprobieren kannst. Und die Orginaltabelle kannst du jederzeit wieder kopieren, falls etwas nicht so klappen sollte, wie du willst.

Gruß

M.O.