Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
728to732
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
728to732
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dubletten "komplett" entfernen - Hilfe UweD

Dubletten "komplett" entfernen - Hilfe UweD
08.02.2006 09:31:33
Jürgen
Hallo Excel-Forum, hallo UweD,
hatte gestern eine Frage bezüglich löschen von Dubletten im zweiten Tabellenblatt. Habe in Tabelle 1 Adressdaten (eine Adresse eine Zeile).
In Tabelle 2 habe ich die gleichen Adressen + neu hinzugekommene. Jetzt möchte ich in Tabelle 2 alle Adressen löschen, die auch in Tabelle 1 vorkommen, dass nur die neuen Adressen übrigbleiben.
UweD hat mir folgendes Makro zukommen lassen:

Sub Doppelte()
Dim LR1%, LR2%, CC%, TB1, TB2, I%, Z%, M%
Set TB1 = Sheets("Tabelle1")
Set TB2 = Sheets("Tabelle2")
'LR1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
LR2 = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
CC = TB2.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte
Application.ScreenUpdating = False
For Z = LR2 To 2 Step -1
For I = 1 To CC 'vergleichen aller Spalten
If Application.CountIf(TB1.Columns(I), TB2.Cells(Z, I)) >= 1 Then
M = M + 1
End If
Next I
If M = CC Then 'Wenn alle Spalten gleich
TB2.Rows(Z).Delete ' Zeile Löschen
End If
M = 0
Next Z
Application.ScreenUpdating = True
End 

Sub
Leider funktioniert es aber nicht. Es werden keine Adresszeilen gelöscht obwohl es sich definitiv um Dubletten handelt.
Hallo UweD hatte Dir gestern noch geantwortet und heute morgen nochmal eine Nachricht an Deine Antwort gehangen. Höchstwahrscheinlich geht das durch die Menge an Fragen unter.
Kannst Du mir hierbei helfen oder jemand anderer der Excel-Profis.
Besten Dank im Voraus
Jürgen

		

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dubletten "komplett" entfernen - Hilfe UweD
08.02.2006 09:53:18
UweD
Hallo
das hatte ich gestern für dich vorbereitet:
https://www.herber.de/bbs/user/30781.xls
klappt... (wenn du es von Herber aus öffnest, dann wechsel mal zwischen den beiden Tabellen)
- - - -
Allerdings hab ich gemerkt, das die Vergleichsmethode (wie ich feststelle ob auch alle Felder eines Datensatzes gleich sind) trügerisch arbeitet.
Ich arbeite dran..
Gruß UweD
(Rückmeldung wäre schön)
AW: Dubletten "komplett" entfernen - Hilfe UweD
08.02.2006 10:33:01
UweD
Hallo


      
Sub Doppelte()
    
Dim LR1%, LR2%, C1%, C2%, TB1, TB2, I%, Z%, M%
    
Set TB1 = Sheets("Tabelle1")
    
Set TB2 = Sheets("Tabelle2")
    LR1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 
'Letzte Zeile
    LR2 = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
    C1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte
    C2 = TB2.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte
    If C1 <> C2 Then MsgBox "Ungleiche Spaltenanzahl festgestellt," _
        & vbCr & vbCr & 
"Ende der Verarbeitung"Exit Sub
    Application.ScreenUpdating = 
False
    
    
'Hilfsspalten werden erzeugt
    TB1.Columns(1).Insert
    TB2.Columns(1).Insert
    
    
'Erstellen Textstrings Tab1 Es wird ein Text aus allen Feldern zusammengebaut
    For Z = 2 To LR1
        
For I = 2 To C1 + 1
           TB1.Cells(Z, 1) = TB1.Cells(Z, 1) & TB1.Cells(Z, I)
        
Next I
    
Next Z
    
    
'Erstellen Textstrings Tab2
    For Z = 2 To LR2
        
For I = 2 To C2 + 1
           TB2.Cells(Z, 1) = TB2.Cells(Z, 1) & TB2.Cells(Z, I)
        
Next I
    
Next Z
    
    
For Z = LR2 To 2 Step -1
        
If Application.CountIf(TB1.Columns(1), TB2.Cells(Z, 1)) >= 1 Then 'Vergleichen der Texte aus Hilfsspalte
            TB2.Rows(Z).Delete ' Zeile Löschen
        End If
    
Next Z
    
    
'Löschen der Hilfsspalten
    TB1.Columns(1).Delete
    TB2.Columns(1).Delete
    
    Application.ScreenUpdating = 
True
End Sub 


- Es wird je eine Hilfsspalte erzeugt, in der ein Text aus allen Feldern erzeugt wird.
- Diese werden dann auf Duplikate untersucht und entsprechend gelöscht.
- Die Hilfsspalten im Anschluß wieder gelöscht.
hier die neue Musterdatei: https://www.herber.de/bbs/user/30786.xls
Gruß UweD
(Rückmeldung wäre schön)
Anzeige
AW: Dubletten "komplett" entfernen - Hilfe UweD
08.02.2006 12:54:46
Ingo
Hallo Ihr beiden,
was haltet Ihr von der angehängten Lösung
Gruß Ingo
PS eine Rückmeldung wäre nett...

Option Explicit
Sub Doppelte_weg()
Dim LRow1%, LRow2%, LCol%, TB1 As Worksheet, TB2 As Worksheet, ii%, jj%, kk%, Loesch As Boolean
Set TB1 = Sheets("Tabelle1")
Set TB2 = Sheets("Tabelle2")
LRow1 = (TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'Letzte Zeile
LRow2 = (TB2.Cells.SpecialCells(xlCellTypeLastCell).Row) 'Letzte Zeile
LCol = Application.WorksheetFunction.Max(TB1.Cells.SpecialCells(xlCellTypeLastCell).Column, _
TB2.Cells.SpecialCells(xlCellTypeLastCell).Column)   'Letzte Spalte
Application.ScreenUpdating = False
For ii = LRow2 To 2 Step -1
For jj = 2 To LRow1
Loesch = True
For kk = 1 To LCol
If TB2.Cells(ii, kk).Value <> TB1.Cells(jj, kk).Value Then
Loesch = False
Exit For
End If
Next kk
If Loesch Then TB2.Cells(ii, 1).EntireRow.Delete
Next jj
Next ii
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Dubletten "komplett" entfernen - Hilfe UweD
08.02.2006 13:23:02
Jürgen
Ich danke euch beiden recht herzlich.
Beide Makros kommen auf das gleiche Ergebniss. Auf den ersten Blick ist das Ergebniss OK.
Vielen Dank nochmal,
würde das gerne wieder gut machen, aber ich glaube, dafür reichen meine VBA-Kenntnisse nicht aus, euch das Wasser zu reichen.
Gruß Jürgen
Gerne, danke für die Rückmeldung oT
08.02.2006 14:26:37
ingoG
.

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige