Makro ändern
17.01.2004 20:21:59
Rolf St.
In Spalte M stehen bis zu 1000 unterschiedliche Werte untereinander
Das Makro sortiert die ganze Tabelle
und löscht immer die ersten drei gleichen Werte in Zelle M. Es wird die ganze Zeile gelöscht. Beispiel: A kommt 6 mal in Spalte M vor, dan werden die ersten drei A gelöscht (die ganze Zeile), wenn B 10 mal vorkommt werden wieder die ersten drei B (die Ganze Zeile) gelöscht.
Ich möchte nun das statt drei, die ersten 6 gleichen Werte (die ganze Zeile) gelöscht wird.
Könnt ihr mir folgendes Makro daraufhin ändern?
Ich bekomme das nicht hin! Irgendwo muß von ein Befehl von drei auf sechs geändert werden.
Sub dieersten3jeak19012002()
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("Klasse").Range("C:C")) + 1
With Sheets("Erste3jeAK")
.Activate
.Cells.ClearContents
Sheets("Klasse").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
Danke!
Tschüß
Rolf