Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1260to1264
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1260to1264
1260to1264
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Duplikate

Duplikate
Franz
Guten Morgen,
habe hier im Forum ein tolles Makro zum Löschen von Duplikaten gefunden.
Stand im Achiv unter "Thema: Duplikate finden bei großen Datenmengen"
Wollte mir das Makro in meine obere Leiste zum Sofortstart einbinden.
Nun markiert mir das Makro die Dupletten in Spalte G.
Ist es möglich, dass bei Start des Makros nur die vorher markierte Spalte
nach Duplikaten durchsucht wird und automatisch eine Spalte neben der zu
durchsuchenden Spalte (also neben der vorher markierten Spalte) erzeugt wird,
die mit der Info "duplicate" gefüllt wird?
Mit großer Hoffnung
Franz
Option Explicit
Sub Find_Doppelte()
Dim oDic As Object, ArrayData(), ArrayAusgabe()
Dim n As Long
Dim nTimer
nTimer = Timer
Set oDic = CreateObject("Scripting.Dictionary")
With Sheets("Tabelle1") 'Tabelle anpassen
ArrayData = .Range("F3:F130000").Value2 'Zellbereich anpassen
ReDim ArrayAusgabe(1 To UBound(ArrayData), 1 To 1)
For n = 1 To UBound(ArrayData)
oDic(ArrayData(n, 1)) = oDic(ArrayData(n, 1)) + 1
Next n
For n = 1 To UBound(ArrayData)
If oDic(ArrayData(n, 1)) > 1 Then ArrayAusgabe(n, 1) = "duplicate"
Next n
'Ausgabe erste Zelle anpassen
.Range("G3").Resize(UBound(ArrayAusgabe)) = ArrayAusgabe
End With
MsgBox "Fertig nach " & Timer - nTimer & " Sekunden"
End Sub

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Duplikate
08.05.2012 08:03:32
Beverly
Hi Franz, 
Sub Find_Doppelte()
Dim oDic As Object, ArrayData(), ArrayAusgabe()
Dim n As Long
Dim nTimer
nTimer = Timer
Set oDic = CreateObject("Scripting.Dictionary")
ArrayData = Selection.Value2 ' markierter Spaltenbereich
ReDim ArrayAusgabe(1 To UBound(ArrayData), 1 To 1)
For n = 1 To UBound(ArrayData)
oDic(ArrayData(n, 1)) = oDic(ArrayData(n, 1)) + 1
Next n
For n = 1 To UBound(ArrayData)
If oDic(ArrayData(n, 1)) > 1 Then ArrayAusgabe(n, 1) = "duplicate"
Next n
'Ausgabe in Spalte neben der 1. markierten Zelle
Range(Selection.Cells(1).Offset(0, 1).Address).Resize(UBound(ArrayAusgabe)) = ArrayAusgabe
MsgBox "Fertig nach " & Timer - nTimer & " Sekunden"
End Sub

Beachte: Tabellenblatt muss aktiv sein und es muss der zu durchsuchende Spaltenbereich markiert werden, nicht die gesamte Spalte. Die Ausgabe erfolgt in der Spalte rechts daneben, beginnend neben der 1. Zelle.

Anzeige
AW: Duplikate
08.05.2012 08:26:44
Franz
Guten Morgen Karin,
danke für Deine Mühe.
Läuft sehr gut.
Das Einzigste wäre die Ausgabe.
Die findet neben der durchsuchenden Spalte statt.
Problem, hier steht was drinnen. Kann man das so
gestalten, dass zurest neben der zu durchsuchen Spalte eine
leere Spalte eingefügt wird und dann da die Bemerkungen "duplicate"
geschrieben werden?
Liebe Grüße
Columns(n+1).Insert Shift:=xlToRight
08.05.2012 08:50:03
Matthias
Hallo Franz
...
....
......
'Ausgabe in Spalte neben der 1. markierten Zelle
Columns(Selection.Column + 1).Insert Shift:=xlToRight
Range(Selection.Cells(1).Offset(0, 1).Address).Resize(UBound(ArrayAusgabe)) = ArrayAusgabe
......
....
...
Die Hauptsache Du zerstörstt Dir damit keine Formeln ?
Probiere es bitte an einer Kopie !
Gruß Matthias
Anzeige
AW: Columns(n+1).Insert Shift:=xlToRight
08.05.2012 09:11:49
Franz
Hallo Matthias,
danke auch Dir....
Gruß
Franz
AW: Duplikate
08.05.2012 08:50:23
Beverly
Hi Franz,
ergänze vor der Kommentarzeile 'Ausgabe in... diese Codezeile: 
    Columns(Selection.Cells(1).Offset(0, 1).Column).Insert shift:=xlToRight


AW: Duplikate
08.05.2012 08:58:42
Franz
Hallo Karin,
vielen Dank.
Einen schönen Tag noch.
Gruß
Franz
AW: Duplikate
08.05.2012 09:21:32
Franz
Hallo Karin, hallo Matthias!
Doch noch eine Frage:
Sehe gerade beim Testen, dass alle Duplikate markiert werden.
Aber wollte nur die echten "Duplikate" markiert haben.
D.h., das Original soll keine Markierung mit "duplicate" bekommen.
Vielleicht noch eine kleine Hilfe.
Gruß
Franz
Anzeige
AW: Duplikate
08.05.2012 10:17:22
Franz
Hallo,
hatte vergessen den Haken bei "Frage noch offen" zu setzen.
Gruß
Franz
AW: Duplikate
08.05.2012 10:30:53
Beverly
Hi Franz,
das macht aber auch dein ursprünglicher Code, ich hatte ihn nur an deine veränderten Bedingungen bezüglich ausgewähltem Spaltenbereich angepasst.
Versuche es mal hiermit: 
Sub Find_Doppelte()
Dim oDic As Object, ArrayAusgabe()
Dim n As Long
Dim nTimer
nTimer = Timer
Set oDic = CreateObject("Scripting.Dictionary")
Set oDic = Selection ' markierter Spaltenbereich
ReDim ArrayAusgabe(1 To oDic.Count)
For n = 1 To oDic.Count
If Application.CountIf(oDic, oDic(n)) > 0 Then
If Not IsError(Application.Match(oDic(n), oDic, 0)) Then
If Application.Match(oDic(n), oDic, 0)  n Then ArrayAusgabe(n) = "duplicate"
End If
End If
Next n
Columns(Selection.Cells(1).Offset(0, 1).Column).Insert shift:=xlToRight
'Ausgabe in Spalte neben der 1. markierten Zelle
Range(Selection.Cells(1).Offset(0, 1).Address).Resize(UBound(ArrayAusgabe)) = Application. _
Transpose(ArrayAusgabe)
MsgBox "Fertig nach " & Timer - nTimer & " Sekunden"
End Sub


Anzeige
AW: Duplikate
08.05.2012 10:35:24
Franz
Danke Karin,
Dein neuer Code läßt mir jetzt das Original ohne Bemerkung "duplicate".
Damit kann ich besser diese Hilfsspalte sortieren oder mit dem Autoselekt bearbeiten.
Super. Danke.
Gruß
Franz
Fragwürdiger Code
09.05.2012 23:55:21
Erich
Hi Franz,
den letzten Code zu Find_Doppelte() möchte ich so nicht unkommentiert stehen lassen - er enthält einige Ungereimtheiten
und sollte keinen Vorbildcharakter haben.
Ich geh das mal durch:
Dim oDic As Object ' war sinnvoll, solange CreateObject("Scripting.Dictionary") noch sinnvoll war.
Dim ArrayAusgabe() sollte "As String" sein.
Dim nTimer sollte "As Single" sein
Set oDic = CreateObject("Scripting.Dictionary")
ist Unfug, wird in der nächsten Zeile überschrieben
Set oDic = Selection ' markierter Spaltenbereich - oDic ist also Range-Objekt und sollte so deklariert sein.
If Application.CountIf(oDic, oDic(n)) > 0 Then
ist Unfug: Es wird geprüft, ob der n-te Wert der Selektion in der Selektion vorkommt - das stimmt immer.
If Not IsError(Application.Match(oDic(n), oDic, 0)) Then
ist ebenso Unfug: Es wird wieder geprüft, ob der n-te Wert der Selektion Liste in der Selektion vorkommt - das stimmt immer.
Columns(Selection.Cells(1).Offset(0, 1).Column) ist nichts anderes als
Columns(Selection.Column + 1)
Range(Selection.Cells(1).Offset(0, 1).Address).Resize(UBound(ArrayAusgabe)) ist nichts anderes als
Selection.Offset(, 1)
Range, Cells, Address, Resize und UBound kann man sich hier leicht sparen...
Ich will nicht nur meckern. Hier mein Code-Vorschlag: 

Sub Find_Doppelte2()
Dim nTimer As Single, arrSel, ArrayAusgabe() As String, n As Long
nTimer = Timer
arrSel = Selection            ' markierter Spaltenbereich in Array
ReDim ArrayAusgabe(1 To UBound(arrSel))
For n = 1 To UBound(arrSel)
If Application.Match(arrSel(n, 1), arrSel, 0)
Rückmeldung wäre nett! - Nix für ungut und Grüße aus Kamp-Lintfort von Erich
Anzeige
AW: Fragwürdiger Code?
10.05.2012 07:56:26
Beverly
Hi Erich,
die Zeile 
If Application.CountIf(oDic, oDic(n)) > 0 Then

muss natürlich heißen 
If Application.CountIf(oDic, oDic(n)) > 1 Then

und verhindert, dass der Code überhaupt erst in die If-Verzweigung geht falls der Wert nur einmalig vorhanden ist
Die Zeile 
If Not IsError(Application.Match(oDic(n), oDic, 0)) Then

ist sehr wohl notwendig, denn wenn eine Leerzelle auftritt wird andernfalls ein Fehler ausgelöst, was bei deinem Code der Fall ist.

Anzeige
Code verbesserungsfähig
10.05.2012 10:53:25
Erich
Hi Karin,
vermutlich sind wir uns einig darin, dass der besagte Code verbesserungsfähig war. :-)
Und einig sind wir sicher auch darin, dass mein Codevorschlag fehlerhaft war. :-(
"If Application.CountIf(oDic, oDic(n)) > 1 Then" ist natürlich sinnvoll, aber nicht notwendig, kann beschleunigen.
Mit "If Not IsError(Application.Match(oDic(n), oDic, 0)) Then" abzuprüfen, ob oDic(n) leer ist, geht natürlich,
scheint mir aber wenig naheliegend. Da schlage ich den direkten Weg vor:
If Not (IsEmpty(arrSel(n, 1)) Or IsError(arrSel(n, 1))) Then
"sehr wohl notwendig" ist die Prüfung, nicht aber, diese Prüfung mit Match vorzunehmen.
Mein Fazit: 

Sub Find_Doppelte3()
Dim nTimer As Single, arrSel, ArrayAusgabe() As String, n As Long
nTimer = Timer
arrSel = Selection            ' markierter Spaltenbereich in Array
ReDim ArrayAusgabe(1 To UBound(arrSel))
For n = 1 To UBound(arrSel)
If Not (IsEmpty(arrSel(n, 1)) Or IsError(arrSel(n, 1))) Then
If Application.Match(arrSel(n, 1), arrSel, 0)
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige