Ich möchte 2 Spalten vergleichen und die Unterschiede visuell darstellen.
Super wäre es wenn dies über eine Formel zu lösen wäre damit nicht immer VBA gestartet werden muss !
Bin für jeden Rat Dankbar
Peter
| |||||||||||||||||||||||||||||||||||
Sub mainVergleichZellen()
Dim iZeile As Integer
Dim iZaehlerZeile As Integer
Dim vInhaltSpalte1 As Variant, vInhaltSpalte2 As Variant
iZaehlerZeile = Cells(Rows.Count, 1).End(xlUp).Row
For iZeile = 1 To iZaehlerZeile
vInhaltSpalte1 = Cells(iZeile, 1)
vInhaltSpalte2 = Cells(iZeile, 2)
If Len(vInhaltSpalte1) >= Len(vInhaltSpalte2) Then
iZaehlerFarbArray = Len(vInhaltSpalte1)
Else
iZaehlerFarbArray = Len(vInhaltSpalte2)
End If
Call Inhalt2Array(vInhaltSpalte1, vInhaltSpalte2)
Call ArrayVergleichen
Call FormatierenZelle(Cells(iZeile, 1), Cells(iZeile, 2))
Next iZeile
End Sub
Sub Inhalt2Array(vZelle1 As Variant, vZelle2 As Variant)
Dim iZaehlerArray As Integer
Dim iZaehler As Integer
For iZaehler = 1 To 2
iZaehlerArray = iZaehlerFarbArray
Select Case iZaehler
Case 1
ReDim Preserve vArrZelle1(iZaehlerArray - 1)
For iZaehlerArray = 0 To iZaehlerArray - 1
vArrZelle1(iZaehlerArray) = Mid(vZelle1, iZaehlerArray + 1, 1)
Next iZaehlerArray
Case 2
ReDim Preserve vArrZelle2(iZaehlerArray - 1)
For iZaehlerArray = 0 To iZaehlerArray - 1
vArrZelle2(iZaehlerArray) = Mid(vZelle2, iZaehlerArray + 1, 1)
Next iZaehlerArray
End Select
Next iZaehler
End Sub
Sub ArrayVergleichen()
Dim iZaehler As Integer
ReDim vZeichenGruen(iZaehlerFarbArray - 1)
ReDim vZeichenRot(iZaehlerFarbArray - 1)
For iZaehler = 0 To iZaehlerFarbArray - 1
If vArrZelle1(iZaehler) = vArrZelle2(iZaehler) Then
vZeichenRot(iZaehler) = 0
Else
vZeichenRot(iZaehler) = 1
End If
Next iZaehler
End Sub
Sub FormatierenZelle(rngZelle1 As Range, rngZelle2 As Range)
Dim iZaehlerSpalte As Integer, iZaehlerZeichen As Integer
Dim iFarbe As Integer
For iZaehlerSpalte = 1 To 2
Select Case iZaehlerSpalte
Case 1
rngZelle1.Activate
Case 2
rngZelle2.Activate
End Select
For iZaehlerZeichen = 1 To iZaehlerFarbArray
If vZeichenRot(iZaehlerZeichen - 1) = 0 Then
iFarbe = 4
Else
iFarbe = 3
End If
With ActiveCell.Characters(Start:=iZaehlerZeichen, Length:=1).Font
.ColorIndex = iFarbe
End With
Next iZaehlerZeichen
Next iZaehlerSpalte
End Sub