Sheets vergleichen, zwei Suchwörtern, markieren

Servus Excelgemeinde,
ich stehe vo einem kleinen Problem. Ich soll zwei Excelsheets miteinader vergleichen und die ungleichen Stellen rot markieren. Das Excel besteht aus über 3500 Zeilen und 48 Spalten die verglichen werden sollen. Also fällt eine Exelformel raus. Ich habe eine Beispieldatei hochgeladen.
https://www.herber.de/bbs/user/104826.xlsm
Der Reiter "Original" und "Vergleich" soll miteinader verglichen werden. Das Ergebniss soll wie in Reiter "Vergleich nach Lauf" im Reiter Vergleich dargestell sein.
Um eine Zeile (F-BA) im Sheet Vergleich mit dem anderen Sheet zu vergleichen, muss "Nachname" und "Geb" in beiden Sheets übereinstimmen. Sollte eins der beiden Felder leer sein, kann diese Zeile übersprungen werden.
Output: In Spalte A soll eine rot/grün Markierung signalisieren, dass etwas falsch ist. Der falsche Wert soll rot in der betroffenen Zeile hinterlegt sein.
Ist so etwas über VBA machbar? Ich hoffe auf Eure Unterstützung.
Vielen Dank Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub sDaniel() sR = Worksheets("Original").UsedRange.Address Debug.Print sR Debug.Print Split(sR, "$")(4) Debug.Print Val(Split(sR, "$")(2)) For i = 1 To Split(sR, "$")(4) 'Zeilen For j = 1 To Val(Split(sR, "$")(2)) 'Spalten If Worksheets("Original").Cells(i, j) Worksheets("Vergleich").Cells(i, j) Then Worksheets("Original").Cells(i, j).Interior.Color = vbYellow End If Next j Next i End Sub

Sub Vergleich() Dim c As Range, blnDif As Boolean Dim lngR As Long, lngC As Long, zz As Long, cc As Long Dim suchwort As String With Worksheets("Original").Range("C9:BA53") Set c = .Find(What:="Maier") End With d = c.Row For j = 6 To lngC 'Spalten If Worksheets("Original").Cells(d, j) Worksheets("Vergleich").Cells(d, j) Then Worksheets("Original").Cells(d, j).Interior.Color = vbYellow End If Next j End Sub

Servus,
ich habe schon mal die Suche hinbekommen, aber er bringt mir immer ein Anwendungsfehler bei "Set rng = .Range("C9..."
Hast du eine Idee?

Sub Vergleich()
Dim blnDif As Boolean
Dim suchwort1 As Range, suchwort2 As Range, rng As Range
Dim lngR As Long, lngC As Long
'Suchwörter definieren
With Worksheets("Original").Range("A1:BA53")
Set suchwort1 = .Cells(9, 3)
Set suchwort2 = .Cells(9, 5)
End With
'    MsgBox suchwort1
'    MsgBox suchwort2
With Worksheets("Vergleich")
lngR = .Cells(.Rows.Count, 3).End(xlUp).Row
lngC = .Cells(5, .Columns.Count).End(xlToLeft).Column
Set rngT1 = .Range(.Cells(9, 6), .Cells(lngR, lngC))
Cells(9, 6).Select
End With
'Suchen & Vergleich
With Worksheets("Vergleich")
Set rng = .Range("C9:C" & lngR).Find(suchwort1)
MsgBox rng.Row
If .Cells(rng.Row, 5) = suchwort2 Then
For j = 6 To lngC 'Spalten
If Worksheets("Original").Cells(9, j)  Worksheets("Vergleich").Cells(rng.Row,  _
j) Then
Worksheets("Original").Cells(9, j).Interior.Color = vbYellow
End If
Next j
Else
MsgBox "nix gefunden"
End If
End With
End Sub

Sub Vergleich() Dim d As Integer Dim suchwort1 As String, suchwort2 As String Dim rng As Range Dim lngR As Long, lngC As Long, LastColumn As Long 'Suchwörter definieren With Worksheets("Original") suchwort1 = .Cells(9, 3) suchwort2 = .Cells(9, 5) End With With Worksheets("Vergleich") lngR = .Cells(.Rows.Count, 3).End(xlUp).Row lngC = .Cells(5, .Columns.Count).End(xlToLeft).Column 'Suchen & Vergleich Set rng = .Range("C9:C" & lngR).Find(suchwort1) MsgBox rng.Row If .Cells(rng.Row, 5) = suchwort2 Then For j = 6 To lngC 'Spalten If Worksheets("Original").Cells(9, j) Worksheets("Vergleich").Cells(rng. _ Row, j) Then Worksheets("Original").Cells(9, j).Interior.Color = vbYellow Worksheets("Original").Cells(9, 1).Interior.Color = vbRed Else Worksheets("Original").Cells(9, 1).Interior.Color = vbGreen End If Next j Else MsgBox "nix gefunden" End If End With End Sub

Beliebteste Forumthreads (12 Monate)

Sheets vergleichen, zwei Suchwörtern, markieren

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

197 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Sheets vergleichen, zwei Suchwörtern, markieren

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

197 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread