Anzeige
Archiv - Navigation
204to208
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
204to208
204to208
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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?

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige