PDA

Vollständige Version anzeigen : Dubletten finden und nebeneinander kopieren


MiDeN_0913
22.09.2016, 15:14
Hallo zusammen,

benötige wieder Euere Hilfe. Ich habe eineTabelle mit ca. 5000 Datensätzen.
Spalte A, B, C sind belegt und sortiert. In der Spalte B befindet sich jeweils untereinander der Wert der auf Duplikate überprüft werden soll. Wenn der Wert doppelt ist, dann soll der Inhalt aus C kopiert und nebeneinander dargestellt werden, die Zeile mit der dublette anschliessend löschen.

kurzes Bsp.

A1 B1 C1
A2 B2 C2
A3 B2 C3 soll zu

A1 B1 C1
A2 B2 C2 C3

Könnte sich jemand das mal bitte anschauen? Ich habe einen Code gefunden, der genau das macht was ich mir vorstelle, bis auf das löschen. Dort werden die falschen Zeilen entfernt. Darf ich den einfach so hier posten (im Netz gefunden)?

Vielen lieben Dank

Oge
22.09.2016, 16:05
Ja. Ja.

MiDeN_0913
22.09.2016, 16:32
Ok, hier ist er. Wie gesagt, sobald mehr als eine Dublette vorhanden, wird die falsche Zeile gelöscht. Und unperformant ist er auch noch. Für jegliche Hinweise bin ich sehr dankbar!

Sub Duplikate_finden_und_auslagern()
Dim iRow1 As Integer, iRow As Integer, iRow_Duplikat As Integer, _
iCol As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

iRow1 = 2

For iRow = 2 To Range("B65536").End(xlUp).Row
iRow1 = iRow1 + 1
For iRow_Duplikat = iRow1 To Range("B65536").End(xlUp).Row
If Cells(iRow, 2) = Cells(iRow_Duplikat, 2) Then
iCol = Range("L" & iRow).End(xlToLeft).Column
Cells(iRow_Duplikat, 3).Copy
Cells(iRow, iCol).Insert Shift:=xlToRight
'Rows(iRow_Duplikat).Delete
End If
Next
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


LG

Oge
22.09.2016, 17:13
Hallo Miden,

du scheinst das Programm schon einmal getestet zu haben. Dann lad doch bitte eine Testdatei hoch damit
a) die Helfer die Arbeit nicht noch einmal machen müssen und
b) anhand des Beispiels eventuell zusätzliche Fregestellungen geklärt werden können.


Im code kann ich nicht erkennen dass das Programm die falschen Zeilen löscht, aber dadurch, dass es mit einer festen For-Schleife arbeitet und Zeilen innerhalb des Bereiches löscht, übersieht es Duplikate wenn sie direkt hintereinander stehen.
An der Geschwindigkeit kann man auch etwas machen, wenn man die eingebauten Bremsen entfernt.

Vorab einige Fragen:

a) Müssen nur Werte verschoben werden?
b) Wieviele Zeilen sind maximal zu erwarten?
c) In deinem Beispiel geht die Information A3 verloren. Ist dies so richtig?

MiDeN_0913
22.09.2016, 18:06
Hi Oge,
sorry, anbei die Datei. Ca 5.000 Zeilen sind zu erwarten, es sollen nur Werte verschoben werden, und die Infos in A sind unwichtig.

Vielen Dank

Oge
22.09.2016, 21:42
Hallo Miden,

in der Anlage eine Beispieldatei. Du kannst zum Testen die Formeln auf einige tausend Zeilen kopieren.

Und hier der code:

Option Explicit
Option Base 1
Private Sub cmdDublettenVerschieben_Click()

Dim lngAltZeile As Long
Dim lngDupZeile As Long
Dim lngAktZeile As Long
Dim lngAktSpalte As Long
Dim lngAnzZeilen As Long

Dim varArrAlt As Variant
Dim varArrNeu() As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

varArrAlt = Range("B1:C" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).Value

lngAnzZeilen = UBound(varArrAlt, 1)
ReDim varArrNeu(lngAnzZeilen, 2)

lngAktZeile = 0
For lngAltZeile = 1 To lngAnzZeilen
If varArrAlt(lngAltZeile, 1) <> "" Then
lngAktZeile = lngAktZeile + 1
lngAktSpalte = 3
varArrNeu(lngAktZeile, 1) = varArrAlt(lngAltZeile, 1)
varArrNeu(lngAktZeile, 2) = varArrAlt(lngAltZeile, 2)
If lngAltZeile < lngAnzZeilen Then
For lngDupZeile = lngAltZeile + 1 To lngAnzZeilen
If varArrAlt(lngDupZeile, 1) = varArrAlt(lngAltZeile, 1) Then
varArrAlt(lngDupZeile, 1) = ""
lngAktSpalte = lngAktSpalte + 1
ActiveSheet.Cells(lngAktZeile, lngAktSpalte) = varArrAlt(lngDupZeile, 2)
End If
Next lngDupZeile
End If
End If
Next lngAltZeile

Range("B1:C" & lngAnzZeilen).Value = varArrNeu

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

xlph
22.09.2016, 21:55
Warum willst du die bestehende DB-Tabelle verrupfen und zu etwas machen,
das sich sehr schwer auswerten lässt?

MiDeN_0913
23.09.2016, 08:51
Hallo Oge, funktioniert super, bis auf das löschen der Dubletten. Die sind nach wie vor drin. In der Spalte "B" befinden sich PLZ-Gebiete. Sobald mehrere Händler(Spalte "C") eine PLZ bedienen, sollen sie hintereinander aufgestellt werden: PLZ- Händler1 Händler2, ...HändlerN.
Ziel: eindeutige Werte in "B"

Auch auf die Frage einzugehen, warum die Tabelle zerrupft wird. Es geht lediglich um das kreieren der Überschneidungen. Die Tabelle ist eine Konsolidierung von Daten, die bewusst redundant gehalten werden, und eigentlich nur Mittel zum Zweck.

Hoffe, ich kann das halbwegs gut erläutern.

Oge
23.09.2016, 12:43
Hallo Miden,

was funktioniert, wenn die Dubletten nicht gelöscht werden?
Kannst du eimal eine Datei zeigen in der dies nicht geschíeht? Bitte schreib auch welche Dublette nicht gelöscht wird.

Das Programm prüft auf Gleichheit. Wenn in einer Zelle zusätzliche Leerzeichen sind, sind die Zellen für das Programm nicht gleich.

MiDeN_0913
23.09.2016, 13:54
Lieber Oge,

soeben habe ich meine Orig.Datei noch einmal bereinigt, entformatiert (abermals!), und das Programm nochmal laufen lassen.
Was soll ich sagen, funktioniert perfekt, mega schnell, und macht genau das was ich haben wollte.

1000 Dank & viele liebe Grüße!!!
Miden