kann mir jemand beim Umbau dieses Makros helfen?
Oder kennt jemand eine einfachere Lösung für mein Problem.
Ich möchte immer die ersten drei gleichen Werte in Spalte M löschen (das heißt die komplette Zeile löschen) und alle anderen Werte in der Tabelle behalten.
- Es gibt verschieden viele gleiche Werte in Spalte M
Sub dieersten3jeak()
Dim x As Integer
Dim j As Integer ' Zähler für zu löschende Zeilen
Dim last_row As Integer ' letzte Zeile aus Tabelle 2
Dim temp_field As Variant ' temporäres Datenfeld
Application.ScreenUpdating = False
last_row = Application.WorksheetFunction.CountA(Sheets("Zeitnahme").Range("C:C")) + 1
With Sheets("Erste3jeAK")
.Activate
.Cells.ClearContents
Sheets("Zeitnahme").Range("A2:M" & last_row).Copy
.Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone
Range("A:M").Sort Key1:=Range("M1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
temp_field = .Range("M1:M" & last_row - 1)
For x = last_row - 4 To 1 Step -1
If temp_field(x, 1) = temp_field(x + 3, 1) Then
temp_field(x + 3, 1) = ""
j = j + 1
End If
Next x
.Range("M1:M" & last_row - 1) = temp_field
Range("A:M").Sort Key1:=Range("M1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range(Rows(last_row - j), Rows(last_row)).Delete
.Range("A1").Select
End With
Application.ScreenUpdating = True
End Sub
Vielen Dank für eure Hilfe!
Tschüß
Rolf