Bestimmter Inhalt von Zellen vergleichen
19.03.2016 16:54:13
Zellen
vielleicht kann mir jemand helfen?
Ich möchte bestimmte Werte in Zellen Vergleichen die mit Zeilenumbruch eingetragen wurden.
Zb.
In Zeile A1 steht mit Zeilenumbruch
12345 Hallo
333 NNN
444 aaa
In Zeile B2 steht mit Zeilenumbruch
12345 XYZ
456 aaa
333 beb
Jetzt möchte ich das Zeile A1 mit B2 verglichen wird, und die Zeilen rot einfärbt in denen nur die Zahlenfolgen gleich sind.
Die Einfärbung sollte nur in A1 sichtbar sein.
Der User Tino hat mir schon weiter geholfen, nur leider wird hier nicht nur die Zahlenfolge verglichen sonder auch die Buchstaben dahinter.
Nur wenn beides identisch ist wird es in beiden Zellen Rot.
Sub Beispiel()
With Tabelle1
Call VergleichInhalt(.Range("A1"), .Range("B2"), RGB(255, 0, 0))
End With
End Sub
Sub VergleichInhalt(rng1 As Range, rng2 As Range, lngColor&)
Dim Ar1, nPos1&, nPos2&, n&, sText1$, sText2$, booFund As Boolean
sText1 = rng1.Value
sText2 = rng2.Value
Ar1 = Split(rng1.Value, vbLf)
Union(rng1, rng2).Font.ColorIndex = xlAutomatic
For n = Lbound(Ar1) To Ubound(Ar1)
nPos1 = 1: nPos2 = 1
Do
If nPos2 > 0 Then
nPos2 = InStr(nPos2, sText2, Ar1(n))
If nPos2 > 0 Then
rng2.Characters(Start:=nPos2, Length:=Len(Ar1(n))).Font.Color = lngColor
booFund = True
nPos2 = nPos2 + 1
End If
End If
If nPos1 > 0 And booFund Then
nPos1 = InStr(nPos1, sText1, Ar1(n))
If nPos1 > 0 Then
rng1.Characters(Start:=nPos1, Length:=Len(Ar1(n))).Font.Color = lngColor
nPos1 = nPos1 + 1
End If
End If
Loop While (nPos1 > 0 Or nPos2 > 0) And booFund
booFund = False
Next n
End Sub