Office: Doppelte Werte in Spalten suchen, dann Rest der Zeile zusammenfügen

Hallo zusammen,

ich habe eine sehr große Tabelle vor mir, die ich wie folgt bearbeiten soll.

Es geht um Bauteile, die in verschiedenen Maschinen verwendet werden. Wenn nun die Sachnummer der Teile gleich ist, soll ein Index (weitere Spalte) verglichen werden. Wenn Sachnummer UND Index gleich sind, sollen die beiden (oder mehr) Zeilen zusammengefügt werden.

Alle weiteren Spalten bzw. Zellen dieser Zeilen sollen, sofern unterschiedlich, ebenfalls zusammengefügt werden.
Wenn die anderen Zellen den selben Inhalt haben, muss nicht zwei mal das selbe in der Zelle stehen.

Wichtig sind dann die Spalten "Maschine1", "Maschine2", "Maschine3", "Maschine4". Dort ist dann eine 1 eingetragen, wenn dieses Teil in dieser Maschine verwendet wird.
Wird ein Teil nun in mehreren Maschinen verwendet, ohne dass sich die Sachnummer verändert hat, existieren jetzt für jede Maschine in der das Teil verwendet wird eine Zeile. Stattdessen soll für jede Sachnummer nur eine Zeile vorhanden sein, nur halt die entsprechenden "1en" in den entsprechenden Spalten gesetzt sein -> also zusammenführen. Die nicht gebrauchten Zeilen sollten dann gelöscht werden.

Das Ganze soll nur für bestimmte Baugruppen passieren. Die Baugruppennummer steht in der ersten Spalte. Das sollte mit einer übergeordneten Schleife oder gar If-Abfrage zu schaffen sein. Eingabe der zu bearbeitenden Baugruppennummer über eine Inputbox, und dann IF Spalte = eigegebene.Nummer = weiter.

Als Beispiel ein Auszug aus der Tabelle:

Baugruppe Sachnr Index Struktur Benennung Maschine1 Maschine2 Maschine3 Maschine4
1781 7886250 00 ** KUGEL 5G20 1 1 1
1781 7886250 00 ** KUGEL 5G20 1
1781 7863300 00 DICHTRING A18X22-AL 1 1 1
1781 7863300 00 DICHTRING A18X22-AL 1
1781 7863300 01 DICHTRING A18X22-AL 1 1 1
1782 7886270 00 * KUGEL 6G20 1 1 1
1782 7886270 00 * KUGEL 6G20 1
1783 7863252 00 DICHTRING A16X20-AL 1 1 1
1783 7863252 00 DICHTRING A16X20-AL 1
1956 7881416 00 * RILLENKUGELLAGER 6303 C3 1 1 1
1956 7881416 00 * RILLENKUGELLAGER 6303 C3 1
2450 7886289 00 *** KUGEL 6,35G20 1 1 1
2450 7886289 00 *** KUGEL 6,35G20 1
2450 7886289 01 *** KUGEL 6,35G20 1
2450 7886249 00 *** KUGEL 4,762G20 1 1 1
2450 7886249 00 ** KUGEL 4,762G20 1 1 1
2450 7886249 00 *** KUGEL 4,762G20 1
2450 7886249 00 *** KUGEL 4,762G20 1
2450 7886240 00 *** KUGEL 4G20 1 1 1
2450 7886240 00 *** KUGEL 4G20 1
2450 7886240 00 *** KUGEL 4G20 1
3611 7881048 00 RILLENKUGELLAGER 6005 2RS 1 1 1


Nach der Bearbeitung durch das Makro sollte es dann, für alle Baugruppen durchlaufen, so aussehen:

Baugruppe Sachnr Index Struktur Benennung Maschine1 Maschine2 Maschine3 Maschine4
1781 7886250 00 ** KUGEL 5G20 1 1 1 1
1781 7863300 00 DICHTRING A18X22-AL 1 1 1 1
1781 7863300 01 DICHTRING A18X22-AL 1 1 1
1782 7886270 00 * KUGEL 6G20 1 1 1 1
1783 7863252 00 DICHTRING A16X20-AL 1 1 1 1
1956 7881416 00 * RILLENKUGELLAGER 6303 C3 1 1 1 1
2450 7886289 00 *** KUGEL 6,35G20 1 1 1 1
2450 7886289 01 *** KUGEL 6,35G20 1
2450 7886249 00 *** KUGEL 4,762G20 1 1 1 1
2450 7886240 00 *** KUGEL 4G20 1 1 1 1
3611 7881048 00 RILLENKUGELLAGER 6005 2RS 1 1 1

Ob da jetzt unter MaschineX steht 1 oder 2 oder 1,1 ist dabei egal. Am besten wäre es, wenn die Inhalte von Duplikaten hintereinander stehne würden, da es z.B. auch Felder gibt, in denen Text steht. Also Zelleninhalt1, Zelleninhalt2,... usw.

Ich hoffe es ist klar was ich brauche. Die anderen Suchtreffen haben leider alle nicht so recht gepasst und die Vorlesung in der VBA (leider auch nur rudimentär) vor kam ist mittlerweile über 3 Jahre her..

mfg,

:)

 

Hi mfg,

die Darstellung Deines Problems erinnert mich wieder einmal daran, dass ich dringend zum Augenarzt sollte....*wink.gif*

Also, ohne mich jetzt in Details zu verlieren, versuch es einfach mal Über "Daten --> Filter --> Erweitert" und aktiviere da die Checkbox "Keine Duplikate".

Anschließend kannst Du noch über "Sortieren" festlegen, nach welchen Spalten in welcher Reihenfolge sortiert werden soll.

 

Ja die Tabellen waren eigentlich vernünftig formatiert, aber aus dem Editor wurde die Formatierung leider nicht in den Post übernommen *frown.gif*

Beispielbild im Anhang

Bei deiner Darstellung gehen allerdings die Daten verloren; außerdem besteht die zwingende Bedingung, dass eben die Zeilen, die zwar die gleiche Sachnummer haben, aber einen unterschiedlichen Index parallel bestehen bleiben.

 

Hallo,

die Aufgabe erinnert mich an eine andere Frage, für die ich vor kurzem einen Code geschrieben habe.

Sieh dir mal die Datenstruktur von damals an und den Code und versuche, ob du ihn für deine Aufgab übertragen kannst. Damals wurde nach Semikolon getrennt, hier müßte das angepasst werden.

mfg

PHP:

         000005-102025_01350-L;13.77;EUR;https://s7g10.scene7.com/is/image/bjornborg/000005-102025_01350_1?$BB550$&fmt=jpeg;L
000005-102025_01350-M;13.77;EUR;https://s7g10.scene7.com/is/image/bjornborg/000005-102025_01350_1?$BB550$&fmt=jpeg;M
000005-102025_01350-S;13.77;EUR;https://s7g10.scene7.com/is/image/bjornborg/000005-102025_01350_1?$BB550$&fmt=jpeg;S
151219-103031_70061-L;17.97;EUR;https://s7g10.scene7.com/is/image/bjornborg/151219-103031_70061_1?$BB550$&fmt=jpeg;L
151219-103031_70061-M;17.97;EUR;https://s7g10.scene7.com/is/image/bjornborg/151219-103031_70061_1?$BB550$&fmt=jpeg;M
151219-103031_70061-M;17.97;EUR;https://s7g10.scene7.com/is/image/bjornborg/151219-103031_70061_1?$BB550$&fmt=jpeg;S
151219-103031_70061-S;17.97;EUR;https://s7g10.scene7.com/is/image/bjornborg/151219-103031_70061_1?$BB550$&fmt=jpeg;XS

Sub MrKing()
lr = Cells(Rows.Count, "A").End(xlUp).Row
With CreateObject("scripting.dictionary")
For i = 1 To lr
Un = ""
Tx = Split(Cells(i, "A"), ";")
For j = 1 To UBound(Tx) - 1
Un = Un & Tx(j)
Next j
Debug.Print Un
If Not .exists(Un) Then
.Add Un, "; " & Tx(UBound(Tx))
Else
.Item(Un) = .Item(Un) & "; " & Tx(UBound(Tx))
End If

Next i
For Each k In .keys
Debug.Print k & .Item(k)
Next k
End With
End Sub


 

Hi,

dein Code wirkt, als würde er "nur" die Strings auftrennen; ich habe ja Daten in verschiedenen Spalten. Oder verwechsle ich da was?

 

Hallo,

ja, im Beispiel stand alles in einer Zelle.

In der Zwischenzeit habe ich mir deine Frage etwas genauer angesehen (sollte man eigentlich vor dem Antworten machen). Die erste Antwort mit SpezialFilter und Duplikate entfernen ist recht (sehr) gut. Auch habe ich nicht verstanden, warum mehrfach 4x1(1 1 1 1) im Ergebnis vorkommt, obwohl in den Ausgangsdate Maschiene 4 nicht vorkommt.

mfg

 

Ich hab mich mal an einem Code versucht; allerdings fehlt mir darin zum einen noch die Abfrage bezüglich ob der Index gleich ist, zum anderen fährt das Programm in einer Endlosschleife und nach Abbruch ist die komplette Tabelle leer... *frown.gif*
Ein Abgleich, ob der Zelleninhalt gleich ist, und wenn ja, dass der zweite redundante Zelleninhalt wegfallen soll, fehlt mir ebenfalls.

Stimmt denn die grobe Richtung des Codes wenigstens?

PHP:

         Option Explicit
Sub Doppelt_Red()
Dim lngZeile As Long
Dim lngSpalte As Long
Application.ScreenUpdating = False
lngSpalte = Cells(Columns.Count, 1).End(xlUp).Row
For lngZeile = 6 To Cells(65536, 6).End(xlUp).Row
If Cells(lngZeile, 6) = Cells(lngZeile + 1, 6) Then
If Cells(lngZeile, 9) = Cells(lngZeile + 1, 9) Then
For lngSpalte = 1 To 655
With Range(Cells(lngZeile, 1), Cells(lngZeile + 1, 1))
Tabelle1.Cells(lngSpalte, 1) = Tabelle1.Cells(lngSpalte, 1) & " " & Tabelle1.Cells(lngSpalte + 1, 1)
Tabelle1.Rows(lngSpalte + 1).Delete
End With
Next
End If
End If
Next
Application.ScreenUpdating = True
End Sub


 

...ich hab mir jetzt noch einmal die Mühe gemacht und Deine Aufgabenstellung mindestens 4 mal durchgelesen, verstanden hab ich sie 0 mal. Du verwendest abweichende Begriffe, schreibst von Bauteilen, in der Tabelle gibt es aber Baugruppen (ist das identisch, Kunst oder kann das weg?), sprichst von einer Zusatzspalte Index, die aber schon vorhanden ist, aber das alles ist belanglos. Ich kann nur Vermutungen bezgl. Deines Wunsches anstellen...

Kann es sein, dass Du mit Duplikate entfernen , wie im Bild dargestellt, weiterkommst?

 

Hallo,

ich weis nicht, ob es hilft, aber ich verstehe den Code überhaupt nicht. Warum gibt es eine Schleife über mehr als 500 Spalten?

Ich würde die Spalten "Baugruppe" bis "Benennung" komplet in ein neues Sheet kopieren und dann per Menü die Duplikate entfernen. Danach kann man dann per Makro zusammensuchen, welche Maschinen damit versorgt werden können.

mfg

 

stelle bitte mal eine excel-datei zur verfügung, in der sich deine beispieldaten befinden. man kann in deinem ersten post die spalten von html nicht korrekt zuordnen. das wäre aber für das verstehen der aufgabe sehr wichtig.

 

Hallo,

nein, das hilft mir leider nicht.
Wenn ich nur die Duplikate entferne, dann verliere ich die Information, in welcher Maschine es denn verbaut ist. Deswegen gibt es diesen Eintrag ja mehrfach.
Wird beispielsweise eine M10 Schraube in Maschine 1, 2 und 3 verwendet, gibt es mindestens 3 Einträge. In jeder Spalte für eine Maschine jeweils eine Markierung.
Diese 3 Zeilen sollen dann zusammengeführt werden, nur dass die drei Markierungen (einfach nur eine 1) dann in einer Zeile stehen - dafür dann in jeder der 3 Spalten eine.

Das war nur weil die Schleife, die ich kopiert hatte bis 65536 ging, ich in der Tabelle aber nicht so viele Spalten hatte.

Ich hab mal einen Auszug der Tabelle in den Anhang gepackt, hoffentlich passt das.

Wie gesagt, wichtig ist nur, dass der Inhalt der Zeilen "Maschine1" - "Maschine4" in eine Zeile kommt. Der Rest der Zeile soll bei gleichheit nicht übernommen werden (Redundanz), bei ungleichheit eindach dahinter geschrieben werden.
Es ist auch egal ob es dann eine 1 oder 6 oder 12 ist, Hauptsache der Inhalt kommt rein.

 

...ok... was die Sache für ungeübte Augen erschwert sind ja die Menge der Spezialbezeichnungen, an die man sich ja erst mal gewöhnen muss. Aber die 10er Schraube, das ist ein gutes Beispiel. Hast Du im Bsp.leider nicht drin.... schade... nehmen wir mal die Kugeln (um die Verwirrung etwas einzuschränken).

Vorgabe:
2450 7886289 00 *** KUGEL 6,35G20 1 1 1
2450 7886289 00 *** KUGEL 6,35G20 1
2450 7886289 01 *** KUGEL 6,35G20 1
2450 7886249 00 *** KUGEL 4,762G20 1 1 1
2450 7886249 00 ** KUGEL 4,762G20 1 1 1
2450 7886249 00 *** KUGEL 4,762G20 1
2450 7886249 00 *** KUGEL 4,762G20 1
2450 7886240 00 *** KUGEL 4G20 1 1 1
2450 7886240 00 *** KUGEL 4G20 1
2450 7886240 00 *** KUGEL 4G20 1

als Ergebnis soll rauskommen:

2450 7886289 00 *** KUGEL 6,35G20 1 1 1 1
2450 7886289 01 *** KUGEL 6,35G20 1
2450 7886249 00 *** KUGEL 4,762G20 1 1 1 1
2450 7886240 00 *** KUGEL 4G20 1 1 1 1

wenn ich die letzte nehme (die 4G20) hast Du als Vorgabe
2450 7886240 00 *** KUGEL 4G20 1 1 1
2450 7886240 00 *** KUGEL 4G20 1
2450 7886240 00 *** KUGEL 4G20 1

also 5

im Ergebnis :
2450 7886240 00 *** KUGEL 4G20 1 1 1 1

aber nur 4. Ich hätte jetzt gedacht, Du willst aber eigentlich folgendes:
Fasse alle Bauteile mit 2450 7886240 00 *** KUGEL 4G20 zusammen...
ist nur leider nicht so... oder hast Du Dich oben vertan?

 

Hallo,

in der angehängten Datei möchte ich eine Lösung vorschlagen, soweit ich sie verstanden habe.

Wie gesagt, ich erzeuge zuerst per Hand eine eindeutige List und suche dann die Belegung für die Maschinen zusammen.

PROBLEM: Der verwendete "Range.Find"-Befehl reagiert sehr sensibel auf die Formatierung der Zellen, der Code funktioniert nur, wenn in beiden Sheets die Spalte F mit "Standard" formatiert ist.

mfg

 

hier ist mein hut im ring:
die tabelle wird mit sql abgefragt und zusammengeführt. 10 zeilen code.
bitte zu prüfen.

hier das sql-statement:
Code:

hier die datei:
FuerForum.xlsm

 

Hi,

beim Anpassen des Codes (Sheets(1) zu Tabelle1, analog für Tabelle2 bzw Sheets(2)), haut er mir einen Fehler raus, dass bei "LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)" ein Objekt erforderlich ist..
Leider bin ich ein wenig unbedarft dabei.

So sieht das jetzt aus:

PHP:

         Sub Zusammenfassen()

'Spalte F MUSS als "Standart" formatiert sein

Dim rng As Range
'die ganze Tabelle in neues Sheet kopieren, "Menü: Daten: Duplikate entfernen"
lr = Tabelle2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To lr

Set rng = Tabelle1.Columns("F").Find(Tabelle2.Cells(i, "F"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

If Not rng Is Nothing Then
s = rng.Address
Do
If Tabelle2.Cells(i, "A") = Tabelle1.Cells(rng.Row, "A") And _
Tabelle2.Cells(i, "I") = Tabelle1.Cells(rng.Row, "I") And _
Tabelle2.Cells(i, "T") = Tabelle1.Cells(rng.Row, "T") And _
Tabelle2.Cells(i, "U") = Tabelle1.Cells(rng.Row, "U") Then
Tabelle1.Range(Sheets(1).Cells(rng.Row, "Z"), Tabelle1.Cells(rng.Row, "AC")).Copy
Tabelle2.Cells(i, "Z").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
End If
Set rng = Tabelle1.Columns("F").FindNext(rng)
Loop Until rng.Address = s
End If
Next i
End Sub