Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Doppelte raus, aber aus 3 Kriterien

Forumthread: Doppelte raus, aber aus 3 Kriterien

Doppelte raus, aber aus 3 Kriterien
22.01.2003 18:15:06
Hansi
Hallo Leute,

hab mein Vorhaben umgewandelt und nun stellt sich folgender Sachverhalt dar:

Habe eine Tabelle mit folgenden Spalten:
A = Nachname
B = Vorname
C = Geburtsdatum

1. Jetzt möchte ich diese Spalten nach A sortieren lassen per Makro - soweit kein Problem

2. Jetzt sollen die Doppelten Einträge rausfliegen. Es ist aber unbedingt notwendig alle drei Felder (Nachname, Vorname und Geburtsdatum) auf Gleichheit zu überprüfen.
Nur wenn diese identisch sein sollten, fliegt der Übrige (doppelte) raus.

- diesen Schritt bekomme ich einfach nicht hin.

Wer kann helfen?

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Doppelte raus, aber aus 3 Kriterien
22.01.2003 18:54:42
PeterW
Hallo Hansi,

als Denkanstoß, die dritte Bedimgung schaffst Du sicher alleine:

Gruß
Peter

Re: Doppelte raus, aber aus 3 Kriterien
24.01.2003 13:31:11
R_Weiß
Hallo Hansi,

ich hatte mal ein ähnliches Probelem, und meine Lösung sah so aus:

Sub doppelteRaus() 'Löscht ganze Zeile, wenn Einträge in Name, Straße und Vorname gleich sind.
Dim liZeile&
With Application
.ScreenUpdating = False
.Calculation = xlManual
.CalculateBeforeSave = False
End With
Sheets(3).Activate
'Cells.Select
[a1].Select
ActiveCell.CurrentRegion.Select
Selection.Sort Key1:=Range("D2"), Key2:=Range("G2"), _
Key3:=Range("E2"), Header:=xlYes, MatchCase:=False
liZeile = 1
Do
liZeile = liZeile + 1
Cells(liZeile, 1).Select
If ActiveCell.Value = "" Then Exit Do
Application.StatusBar = "Wir sind in Zeile " & ActiveCell.Row
neuTesten:
If Cells(liZeile, 4).Text = Cells(liZeile + 1, 4).Text _
And Cells(liZeile, 5).Text = Cells(liZeile + 1, 5).Text _
And Cells(liZeile, 7).Text = Cells(liZeile + 1, 7).Text Then
Rows(liZeile).EntireRow.Delete
GoTo neuTesten:
End If
Loop
With Application
.Calculation = xlAutomatic
.StatusBar = False
End With
End Sub

Ich hoffe, Du kannst was damit anfangen.

Gruß aus RE

Rainer Weiß

Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige