AW: auch der Test an der Originaltabelle hat geklappt
14.08.2017 21:23:21
Jenny
Hallo Christian,
die Zeile wird beim Einfügen rot... Syntaxfehler.
Mit dem Dup Entf. ist gemeint, wie wenn ich den kompletten gefüllten Bereich markiere, die normale Excel Funktion nutze und da die Spalten A und E einen Haken setze.
hier das aufgezeichnete Makro, wobei die Ranges bei zukünftigem Ausführen jedesmal andere sein werden.
Sub Makro1()
' Makro1 Makro
Range("A1:II15282").Select
Range("D15213").Activate
ActiveSheet.Range("$A$1:$II$15282").RemoveDuplicates Columns:=Array(1, 5), _
Header:=xlNo
End Sub
Aber ich habe mich doch entschieden, dich entscheiden zu lassen, wieviel Arbeit das ist, das mit dem Sortieren umzusetzen.
Was ich mache, bevor ich sortiere. Ich markiere den Bereich von E2 bis zum Ende der Daten in Spalte E, drücke dann Strg+C und Strg+V
Das hat dann zur Folge dass unten stehendes Makro ausgeführt wird.
Dann sortiere ich nach Spalte F absteigend, dann Spalte C aufsteigend.
Im Anschluss daran markiere ich nochmal Bereich von E2 bis zum Ende der Daten in Spale E, drücke dann Strg+C und Strg+V und lasse das Makro nochmal durchlaufen.
Wenn du jetzt fragst warum 2mal, das erste mal ist dafür da, dass überhaupt alle notwendigen Daten in den Spalten C und F stehen, damit nach diesen Spalten sortiert werden kann. Das zweite mal, damit die Formeln richtig berechnet werden, die von der Sortierreihenfolge abhängen.
Das Makro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TC As Long
Dim c As Range
Application.ScreenUpdating = False
If Target.Columns.Count > 1 Then Exit Sub
If Target.Column = 5 Or Target.Column = 7 Then TC = Target.Column Else Exit Sub
'If Target.Count = 1 And Target "" Then
On Error GoTo ERREXIT
Application.EnableEvents = False
Select Case TC
Case 5: For Each c In Target
If c "" Then Call SpalteE(c)
Next
Case 7: For Each c In Target
If c "" Then
Call SpalteG(c)
Call SpalteE(c)
End If
Next
End Select
ERREXIT:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub SpalteG(ByVal Target As Range)
Dim r As Range, c As Range, z&, cc As Range, zf&
Dim gefunden As Boolean
If Target.Offset(, -6) "" Then
z = Target.Row
gefunden = False
Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _
Range("A1"), xlValues, xlWhole)
If Not cc Is Nothing Then
zf = cc.Row
Do
Set cc = Range("A1:A" & z - 1).FindNext(cc)
If cc.Offset(, 6) = Target Then
Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address)
gefunden = True
End If
Loop Until cc Is Nothing Or cc.Row = zf Or gefunden
End If
If Not gefunden Then Target.Offset(, -2).Value = "n.v."
End If
End Sub
Sub SpalteE(ByVal Target As Range)
Dim lngR As Long
lngR = Target.Row
Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1
Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1
Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1
Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1
Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1
Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1
Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1
Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1
Rows(lngR).Copy
Cells(lngR, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Target.Select
End Sub