AW: Tabellen sortieren und vergleichen
01.12.2005 13:29:57
Unbekannter
Gut du musst dann bei den "sort" befehl die Range und die zu sortierenden Spalten ändern,der Rest sollte passen
p.s. Das Makro habe ich getestet also wenn es nicht geht liegts daran das du die spalten nachkustieren musst.
Sub sortieren()
On Error Resume Next
Sheets(1).Range("A1:O").Sort Key1:=Range("m2"), _
Order1:=xlAscending, Key2:=Range("n2") _
, Order2:=xlAscending, Key3:=Range("o2"), Order3:=xlAscending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Sheets(2).Range("A1:M10000").Sort Key1:=Range("j2"), _
Order1:=xlAscending, Key2:=Range("k2") _
, Order2:=xlAscending, Key3:=Range("l2"), Order3:=xlAscending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Call vergleichen
End Sub
Sub vergleichen()
For a = 2 To 10000
For b = 2 To 10000
For c = 0 To 3
If Sheets(1).Cells(a, 11 + c) <> Sheets(2).Cells(b, 30 + c) Then
'Die 11,30 stehen jeweils für die Nummer der Anfangsspalten wo verglichen wird
Else
d = d + 1
End If
Next c
If d = 3 Then
Sheets(1).Rows(a).Copy
Sheets(3).Rows(Sheets(3).Cells(Rows.Count, 1).End(xlUp) + 1).Insert
End If
d = 0
Next b
Next a
End Sub
Viel spass und Gruß UN1