AW: Mehrfach einträge in tabelle löschen
07.06.2020 14:10:15
Richi
Sali Werner
Besten Dank für deinen Code. Funktioniert einwandfrei.
Probleme habe ich bei der Entschlüsselung des Codes. FormulaR1C1 = "=RC[-11]&RC[-3]"... etc...
Wenn ich da mal was nachbessern möchte weil sich die Tabelle verändert finde ich mich nicht zurecht.
Liebe Gruess
Richi
----------------
Sub Schaltfläche1_Klicken()
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("Single Line")
loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(.Cells(2, "M"), .Cells(loLetzte, "M")).FormulaR1C1 = "=RC[-11]&RC[-3]"
.Range(.Cells(2, "M"), .Cells(loLetzte, "M")).Value = .Range(.Cells(2, "M"), .Cells( _
loLetzte, "M")).Value
.Range(.Cells(2, "N"), .Cells(loLetzte, "N")).FormulaR1C1 = _
"=IF(COUNTIF(C[-1],RC[-1])>1,""Mehrfach"","""")"
.Range(.Cells(2, "N"), .Cells(loLetzte, "N")).Value = .Range(.Cells(2, "N"), .Cells( _
loLetzte, "N")).Value
If WorksheetFunction.CountIf(.Columns("N"), "Mehrfach") > 0 Then
.Range("$A$1:$N$" & loLetzte).RemoveDuplicates Columns:=Array(1, 10), Header:=xlYes
.Range("A1").CurrentRegion.AutoFilter , field:=14, Criteria1:=""
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Columns("G") = 8000
.Offset(1).Resize(.Rows.Count - 1).Columns("H") = "Mehrfach"
.Offset(1).Resize(.Rows.Count - 1).Columns("I") = 8
End With
If .AutoFilterMode = True Then .AutoFilterMode = False
.Columns("M:N").ClearContents
Else
.Columns("M:N").ClearContents
End If
End With
End Sub