Tabelle nach Schriftfarbe und Dupletten sortieren

Hallo zusammen,
ich hab ein großes Problem:
Ich soll eine Tabelle mit knapp 5000 Personen nach der Schriftfabe sortieren und anschließend eventuelle Dupletten in einer Farbe, die ich dann eingebe löschen. Vielleicht was allgemeines dazu: Es sind jeweils Vorname, Nachname und die Adresse in den Zeilen angegeben und jede Zeile hat eine Farbe (rot, schwarz, blau). Und nach der Sortierung sollen z.B, alle Dupletten in schwarz gelöscht werden. Ich hab sowas noch nie gemacht und mit Makros kenne ich mich fast nicht aus- aber mein Chef hat mir das als Praktikumsaufgabe gegeben und nun bin ich total aufgeschmissen. Viellecht kann mir ja einer von euch ein paar grobe Anhaltspunkte schicken, welche Befehel hierfür notwendig sind- das wäre total lieb!Vielen Dank und schöne Grüße
Allegra

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Mal angenommen die Daten zu den Personen stehen im Bereich A1:C5000.
Dann gibts Du in D1 die Formel =A1&B1&C1 ein und ziehst sie runter bis zum letzten Datensatz.
Anschließend öffnest Du den VBA-Editor mit ALT_F11,gehst auf einfügen-Modul und kopierst in das Modul folgenden Code:


Sub Dubletten_löschen()
Dim x As Integer, i As Integer
Dim d1 As String, d2 As String
For i = 1 To 5000
x = Cells(i, 1).Font.ColorIndex
Cells(i, 5) = x
Next i
Range("A1:E5000").Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
For i = 5000 To 2 Step -1
d1 = Cells(i, 4) & Cells(i, 5)
d2 = Cells(i - 1, 4) & Cells(i - 1, 5)
If d1 = d2 Then
Rows(i).Delete
End If
Next i
End Sub

Danach wieder in Deinem Excelblatt mit Extras-Makros das Makro starten
dann sollte es funktionieren.
Zuerst wird in Spalte E der Farbindex der Schriftfarbe eingetragen, dannn danach und nach den verketteten Datensätzen sortiert und dann die Dubletten gelöscht.
mfG
Ingo Christiansen

Sub Dubletten_löschen() Dim x As Integer, i As Integer, r As Integer Dim d1 As String, d2 As String For i = 1 To 12 x = Cells(i, 1).Font.ColorIndex Cells(i, 5) = x Next i Range("A1:E12").Sort Key1:=Range("D1"), Order1:=xlAscending, Key2:=Range("E1") _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom For i = 12 To 2 Step -1 d1 = Cells(i, 4) & Cells(i, 5) d2 = Cells(i - 1, 4) & Cells(i - 1, 5) If d1 = d2 Then Range(Cells(i, 1), Cells(i, 3)).Copy r = Sheets(2).Range("B65536").End(xlUp).Offset(1, 0).Row With Sheets(2).Cells(r, 2) .PasteSpecial (xlPasteAll) End With Rows(i).Delete End If Next i End Sub

Sub Dubletten_löschen() Dim x As Integer, i As Integer, r As Integer Dim d1 As String, d2 As String For i = 1 To 5000 x = Cells(i, 1).Font.ColorIndex Cells(i, 5) = x Next i Range("A1:E5000").Sort Key1:=Range("D1"), Order1:=xlAscending, Key2:=Range("E1") _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom For i = 5000 To 2 Step -1 d1 = Cells(i, 4) & Cells(i, 5) d2 = Cells(i - 1, 4) & Cells(i - 1, 5) If d1 = d2 Then Range(Cells(i, 1), Cells(i, 3)).Copy r = Sheets("Tabelle2").Range("B65536").End(xlUp).Offset(1, 0).Row With Sheets("Tabelle2").Cells(r, 2) .PasteSpecial (xlPasteAll) End With Rows(i).Delete End If Next i End Sub

Beliebteste Forumthreads (12 Monate)

Tabelle nach Schriftfarbe und Dupletten sortieren

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabelle nach Schriftfarbe und Dupletten sortieren

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread