|
Hallo Kathi,
habe mir gerade mal ein bisschen zeit genommen um dein Problem anzugehen.
Ich hoffe der nachfolgende Code bringt dich in die richtige Richtung.
Sub zeilenabgleich()
'#######################################################################################'
'Dieses Modul gleicht die Inhalte zweier Zellen aus der gleichen Reihe miteinander ab '
'und färbt sich unterscheidene Zeichen aus der Spalte B rot ein. '
'#######################################################################################'
'Variablendeklaration
Dim WertSPA As String
Dim WertSPB As String
Dim WertZeichenSPA As String
Dim WertZeichenSPB As String
Dim LaengeStringSPA As Integer
Dim LaengeStringSPB As Integer
Dim LaengeStringMAX As Integer
Dim ZaehlerZeile As Integer
Dim ZaehlerZeichen As Integer
Dim AnzahlZeilen As Integer
'gefüllte Zeilen in Tabelle1 Spalte A zählen um die Schleifendurchläufe für den Stringabgleich zu begrenzen
AnzahlZeilen = ActiveWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
For ZaehlerZeile = 1 To AnzahlZeilen
'Abfrage, ob sich die Inhalte von Zelle Spalte A und B der aktuellen Zeile gelich sind
If Cells(ZaehlerZeile, 1).Text <> Cells(ZaehlerZeile, 2).Text Then 'wenn sie nicht gleich sind, dann
WertSPA = Cells(ZaehlerZeile, 1).Text 'kopiere den Inhalt der Zelle aus Spalte A in Varaible
LaengeStringSPA = Len(WertSPA) 'und ermittle die Länge des Strings Spalte A
WertSPB = Cells(ZaehlerZeile, 2).Text 'kopiere den Inhalt der Zelle aus Spalte B in Varaible
LaengeStringSPB = Len(WertSPB) 'und ermittle die Länge des Strings Spalte B
'Abfrage zum Ermitteln des längsten Strings um die Schleifendurchläufe zum Vergleichen der Zeichen zu begrenzen
If LaengeStringSPA > LaengeStringSPB Or LaengeStringSPA = LaengeStringSPB Then 'wenn String Spalte A länger oder gleich dem String Spalte B ist, dann
LaengeStringMAX = LaengeStringSPA 'setze die Länge des String Spalte A als Maximalwert
Else 'ansonsten
LaengeStringMAX = LaengeStringSPB 'setze die Länge des String Spalte A als Maximalwert
End If
'Schleife zum Vergleichen einzelner Zeichen aus aktuellem String
For ZaehlerZeichen = 1 To LaengeStringMAX
'aktuelles Zeichen aus String in Variable kopieren
WertZeichenSPA = Left(Mid(WertSPA, ZaehlerZeichen), 1) 'kopiere aktuelles Zeichen aus String Spalte A in Variable
WertZeichenSPB = Left(Mid(WertSPB, ZaehlerZeichen), 1) 'kopiere aktuelles Zeichen aus String Spalte B in Variable
'Abfrage, ob sich die (n)ten Zeichen der String aus Spalte A und B unterscheiden
If WertZeichenSPA <> WertZeichenSPB Then 'wenn sie sich unterscheiden, dann
With Cells(ZaehlerZeile, 2).Characters(Start:=ZaehlerZeichen, Length:=1).Font 'färbe das abweichende Zeichen in Spalte B
.ColorIndex = 3 'rot ein
End With
End If
Next ZaehlerZeichen
End If
Next ZaehlerZeile
End Sub
Ich habe mir eine kleine Excel gebastel, in der ich die Spalten A und B auf Tabelle1 mit Text gefüllt habe.
Tue das doch auch mal und lasse dann mal den Code drüber laufen.
Über eine Rückmeldung würde ich mich sehr freuen
LG aus Hamburg
Andreas
|