AW: 2 Tabellenblätter vergleichen
30.09.2014 17:00:45
KlausF
Hallo Artanan,
dein letzter post kam zu spät. Hier eine Lösung für die Kombination b, c und d.
Sub Finden()
Dim myString As Variant
Dim myColor As Integer
Dim a As Integer
Dim i As Long
Dim findRow As Long
Dim lastRow As Long
Dim lastCol As String
Dim findRng As Range
Dim wksSource As Worksheet
Dim wksZiel As Worksheet
Set wksSource = Worksheets("Extrakt1")
Set wksZiel = Worksheets("Extrakt2")
myColor = 3
lastRow = wksZiel.Cells(Rows.Count, 2).End(xlUp).Row
lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1)
With wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row)
.FormulaR1C1 = "=RC[-254]&RC[-253]&RC[-252]"
.Value = .Value
End With
For i = 3 To lastRow
myString = wksZiel.Range("B" & i).Value & wksZiel.Range("C" & i).Value & wksZiel.Range("D" & _
i).Value
Set findRng = wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row).Find(What:= _
myString, Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not findRng Is Nothing Then
findRow = findRng.Row
For a = 1 To ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
If wksZiel.Cells(i, a).Value wksSource.Cells(findRow, a).Value Then
wksZiel.Cells(i, a).Interior.ColorIndex = myColor
End If
Next a
Else
wksZiel.Range("A" & i & ":" & lastCol & i).Interior.ColorIndex = myColor
End If
Next i
wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Set wksZiel = Nothing
Set wksSource = Nothing
Set findRng = Nothing
End Sub
Gruß
Klaus