2 Tabellenblätter vergleichen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1) For i = 2 To lastRow myString = wksZiel.Range("B" & i).Value Set findRng = wksSource.Range("B2:B" & Cells(Rows.Count, 2).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 Set wksZiel = Nothing Set wksSource = Nothing Set findRng = Nothing End Sub

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

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 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1) For i = 2 To lastRow myString = wksZiel.Range("a" & i).Value Set findRng = wksSource.Range("a2:a" & 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 Set wksZiel = Nothing Set wksSource = Nothing Set findRng = Nothing End Sub

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, 1).End(xlUp).Row lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1) For i = 2 To lastRow myString = wksZiel.Range("B" & i).Value If myString = "" Then GoTo LEER Set findRng = wksSource.Range("B2:B" & Cells(Rows.Count, 2).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 wksZiel.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 LEER: Next i Set wksZiel = Nothing Set wksSource = Nothing Set findRng = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2 Tabellenblätter vergleichen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread