Attribute VB_Name = "Modul1" Option Explicit 'entwickelt von Winfried Radner 'e-mail: Wolf.W.Radzinski@onlinehome.de 'Benutzung frei - ohne Gewähr '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ '+ finde/lösche/markiere/kopiere DUPLIKATE '+ '+++++++++++++++++++++++++++++++++++++++++++++++++ das zugehörige Codefile --> finde_gleiche2.bas ist unter http://www.rendar.de/excel auf dieser Homepage abgelegt. '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ '+ Beschreibung der Funktionen '+ '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ set_parameter '+++++++++++++++++++++++++++++++++++++++++++++++++ set_parameter arg1, arg2, arg3, arg4 Wertebereich(e): arg1= [löschen|markieren|auflisten|kopieren] löschen: löscht alle Doppelten markieren: markiert die Doppelten im Farbwert auflisten: legt Original-Doppel-PAARE in einer Collection ab kopieren: Funktion FEHLT noch! arg2= [True|False] true: es werden nur die selektierten Spalten auf Gleichheit überprüft false:es werden ALLE Spalten (1..256) auf Gleichheit überprüft Zeilenzahl wird über UsedRange ermittelt arg3= Farbwert für die Originale default=vbYellow bzw. 65535 arg4= Farbwert für die Doppelten default=32225 helles rot '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ test_auf_gleich '+++++++++++++++++++++++++++++++++++++++++++++++++ diese Funktion ruft intern die Funktion zeilenvergleich in einer Schleife auf und bestimmt somit die Duplikate bei großen Datenmengen mit wenigen Duplikaten ist die Schleife allerdings ziemlich langsam, deshalb werd ich dieses Programmteil irgendwann sicher durch anderen Code ersetzen. '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ zeilenvergleich '+++++++++++++++++++++++++++++++++++++++++++++++++ Funktion in 2 eigenständige Teile getrennt 1. init_zeilenvergleich() 2. zeilenvergleich() die Initialisierung muß nur 1x vor der Nutzung der Vergleichsfunktion aufgerufen werden und bestimmt notwendige Parameter zeilenvergleich dient nur dazu 2 bereiche auf Geleichheit zu überprüfen, das Ergebnis zu übermitteln und eine Aktion auf den geprüften Daten auszuführen '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ default_parameter '+++++++++++++++++++++++++++++++++++++++++++++++++ setzt globale Variablen auf Anfangswerte '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ set_parameter_ip '+++++++++++++++++++++++++++++++++++++++++++++++++ ermöglicht es globale Variablen mittels einer Inputbox zu setzen der eingetragene String hat die Form ,,, kommasepariert, Wertebereiche der 4 Argumente siehe unter set_parameter weiter oben '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ zeige_treffer_einzeln '+++++++++++++++++++++++++++++++++++++++++++++++++ WENN über Aktion "auflisten" eine TrefferCollection angelegt wurde, dann kann die Auflistung hiermit in Einzelschritten durchlaufen werden - wer die For-Schleife evtl auch abbrechen will muß die Msgbox ändern und die Rückgabe verarbeiten '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ zeige_alle_treffer '+++++++++++++++++++++++++++++++++++++++++++++++++ WENN über Aktion "auflisten" eine TrefferCollection angelegt wurde, dann kann die Auflistung hiermit komplett zweifarbig angezeigt werden NICHT markierte Zeilen haben KEINE Doppelgänger '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ entferne_alle_trefferMarkierungen '+++++++++++++++++++++++++++++++++++++++++++++++++ "zeige_alle_treffer" setzt Farbmarken, die hiermit wieder gelöscht werden können '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ entferne_alle_doppelten '+++++++++++++++++++++++++++++++++++++++++++++++++ hiermit werden entweder die doppelten Zeilen oder nur die doppelten Zellbereiche GELÖSCHT (je nachdem wie selection_only_value bei der Erfassung der Collection eingestellt war) '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ verstecke_alle_doppelten '+++++++++++++++++++++++++++++++++++++++++++++++++ blendet alle DuplikatZEILEN aus (.hidden=True) '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ zeige_alle_doppelten '+++++++++++++++++++++++++++++++++++++++++++++++++ blendet alle DuplikatZEILEN wieder ein (.hidden=False) '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ lösche_GANZE_duplikatzeilen '+++++++++++++++++++++++++++++++++++++++++++++++++ löscht bei Duplikaten IMMER die gesamte Zeile '+++++++++++++++++++++++++++++++++++++++++++++++++ '+++++++++++++++++++++++++++++++++++++++++++++++++ '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ '+ ANWENDUNGSBEISPIEL_1: '+ sucht Duplikate in Spalte A '+ zeigt diese an, versteckt sie und löscht '+ zum Schluß bei Duplikaten IMMER die gesamte Zeile '+ '+++++++++++++++++++++++++++++++++++++++++++++++++ Public Sub ANWENDUNGSBEISPIEL_1() set_parameter "auflisten", True, vbYellow, 32225 Columns(1).Select teste_auf_gleich zeige_alle_treffer MsgBox "", vbOKOnly, "verstecke Duplikate!" verstecke_alle_doppelten MsgBox "", vbOKOnly, "zeige Duplikate wider an!" zeige_alle_doppelten MsgBox "", vbOKOnly, "lösche GANZE Duplikatzeilen!" lösche_GANZE_duplikatzeilen entferne_alle_trefferMarkierungen End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++ '+ '+ ANWENDUNGSBEISPIEL_2: '+ sucht Duplikate in Spalte A '+ versteckt sie und kopiert alle sichtbaren '+ Zeilen ins 2.Arbeitsblatt '+ '+++++++++++++++++++++++++++++++++++++++++++++++++ Public Sub ANWENDUNGSBEISPIEL_2() Dim i As Integer Dim zaehler As Integer set_parameter "auflisten", True, vbYellow, 32225 Application.ScreenUpdating = False With ActiveSheet Columns(1).Select teste_auf_gleich verstecke_alle_doppelten If .UsedRange.Rows.Count < 1 Then Exit Sub zaehler = 0 For i = 1 To .UsedRange.Rows.Count If Rows(i).Hidden = False Then Rows(i).Copy zaehler = zaehler + 1 Worksheets(2).Rows(zaehler).PasteSpecial xlPasteAll End If Next i zeige_alle_doppelten End With Application.ScreenUpdating = True End Sub