VBA Makro - bestimmte Mehrfachnennungen löschen

Makros

Grünschnabel
Hallo zusammen,

ich wäre euch äußerst dankbar, sofern ihr mir hiermit helfen könntet.

Ich versuche mich schon länger daran, allerdings ist mir dieses Makro noch zu komplex.

Die Daten:
Der Spreadsheet besteht aus 8 beschrifteten Spalten (A:H)
Mehrere hundert Zeilen
Sortiert wird nach Spalte A (Name)
Die selben Namen kommen öfter vor.

Was das Makro können sollte:
Bei den doppelten Namenseinträgen, sollen A:C und G:H gelöscht werden.
Und die Zeile mit den kompletten Einträgen also A:H soll zb. blau markiert werden.

Beispiel:
vorher

Name Spalte2 S3 S4 S5 S6 S7 S8

WWW XXX YYY ZZZ AAA BBB CCC DDD
WWW XXX YYY ZZZ AAA BBB CCC DDD
WWW XXX YYY ZZZ AAA BBB CCC DDD
WWW XXX YYY ZZZ AAA BBB CCC DDD
VVV XXX YYY ZZZ AAA BBB CCC DDD
VVV XXX YYY ZZZ AAA BBB CCC DDD

nachher

WWW XXX YYY ZZZ AAA BBB CCC DDD (blau markiert)
........................ZZZ AAA BBB
........................ZZZ AAA BBB
........................ZZZ AAA BBB
VVV XXX YYY ZZZ AAA BBB CCC DDD (blau markiert)
....................ZZZ AAA BBB

(die Punkte sind nur zur besseren Lesbarkeit und sollen natürlich nicht in den Sheet kommen)

Ihr würdet mir meine Arbeit dadurch ungemein erleichtern, da das unglaublich Zeitaufwendig ist.
Falls ihr Tipps habt, würde ich mich sehr freuen!
Liebe Grüße
 
Zuletzt bearbeitet:
Visual Basic:
Public Sub Doppelt()
Dim i As Long
Dim LastRow As Long

    LastRow = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = LastRow To 2 Step -1
    
        If Tabelle1.Cells(i, 1) <> Tabelle1.Cells(i - 1, 1) Then
        
            Tabelle1.Range("A" & i & ":H" & i).Interior.Color = vbBlue
                    
        ElseIf Tabelle1.Cells(i, 1) = Tabelle1.Cells(i - 1, 1) Then
        
            Tabelle1.Cells(i, 1) = ""   'Spalte A
            Tabelle1.Cells(i, 2) = ""   'Spalte B
            Tabelle1.Cells(i, 3) = ""   'Spalte C
            Tabelle1.Cells(i, 7) = ""   'Spalte G
            Tabelle1.Cells(i, 8) = ""   'Spalte H
        
        End If
    
    Next

End Sub
 
Nicht dein Ernst! So flink?!
Ich probiere es gleich aus!
Schon einmal vielen vielen Dank!
Ich melde mich gleich zurück, ob es funktioniert hat!
 
Und? Hats geklappt?
Ich habs mit deinen Pseudo-Daten oben getestet, und hat funktioniert.

Ich sehe zwar ein paar weitere Probleme, aber die kann man ja später angehen.
 

Neue Beiträge

Zurück