Hallo,

leider nicht ganz verständlich. Entweder Beispiel hier einstellen

http://www.netupload.de/

und link hier hinterlegen oder mal anders erklären.

Was verstehst du unter Zuordnung und wie sieht die aus?
Was steht in den Spalten und wie soll die Abweichung dargestellt werden?

Gruß

Helmut

Sorry,

also beide Tabellenblätter sind in den Spalten identisch. Spalte 1 ist eine Kontonummer, Spalte 2 die Bezeichnung, in den Spalten 3-7 sind versch. Codes (Zahlen) eingetragen.

Das 2. Tabellenblatt ist sozusagen das Muster, ich muss jetzt beide Blätter insoweit vergleichen wie die Spalten 2-7 von einander abweichen.

Das Ergebnis muss zählbar sein.

Meine Überlegung gehen momentan in die Richtung einer wenn-Funktion in Verbindung mit Serweis, bin mir aber noch nicht sicher, ob das richtige Weg ist.

Ich hoffe es ist deutlicher geworden, vorab schon mal Danke.

hi all :-)

vielleicht reicht auch eine farbkennung :-)

rot=fehlende zeile
gelb=keine uebereinstimmung der zelle

aufbauend anhand der kontonummern in spalte A

sheet1wie sheet2 in wechselwirkung

Option Explicit
Sub vergleich()
Dim w1x As Integer, w2x As Integer, w3x As Integer, zaehler1 As Integer
Dim w1y As Long, w2y As Long, w3y As Long, zaehler0 As Long
Dim suche1, suche2 As Range
w1x = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
w1y = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
w2x = Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Column
w2y = Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If w1x > w2x Then
w3x = w1x
Else
w3x = w2x
End If
If w1y > w2y Then
w3y = w1y
Else
w3y = w2y
End If
ReDim excel1(w3y, w3x) As Variant
ReDim excel2(w3y, w3x) As Variant
Sheets(2).Select
excel2() = Range(Cells(1, 1), Cells(w3y, w3x))
Sheets(1).Select
excel1() = Range(Cells(1, 1), Cells(w3y, w3x))
For zaehler0 = 2 To w3y
Set suche1 = Sheets(2).Range("A1:A" & w3y).Find(excel1(zaehler0, 1), Lookat:=xlWhole)
Set suche2 = Sheets(1).Range("A1:A" & w3y).Find(excel2(zaehler0, 1), Lookat:=xlWhole)
If Not suche1 Is Nothing Then
For zaehler1 = 2 To w3x
If excel1(zaehler0, zaehler1) <> "" And excel1(zaehler0, zaehler1) <> excel2(suche1.Row, zaehler1) Then
Sheets(1).Cells(zaehler0, zaehler1).Interior.ColorIndex = 6
End If
Next zaehler1
Else
Sheets(1).Range(Sheets(1).Cells(zaehler0, 1), Sheets(1).Cells(zaehler0, w3x)).Interior.ColorIndex = 3
End If
If Not suche2 Is Nothing Then
For zaehler1 = 2 To w3x
If excel2(zaehler0, zaehler1) <> "" And excel2(zaehler0, zaehler1) <> excel1(suche2.Row, zaehler1) Then
Sheets(2).Cells(zaehler0, zaehler1).Interior.ColorIndex = 6
End If
Next zaehler1
Else
Sheets(2).Range(Sheets(2).Cells(zaehler0, 1), Sheets(2).Cells(zaehler0, w3x)).Interior.ColorIndex = 3
End If
Next zaehler0
End Sub

hi all :-)

ich vergass noch speicher satt sollte sein grrr wegen der arrays

gruss nighty