' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub compareText()
Dim rng As Range
Dim lngRow As Long, lngRowCount As Long
Dim lngCol As Long, lngColCount As Long
Dim lngI As Long
Dim bolCompare As Boolean
On Error Resume Next
Set rng = Application.InputBox("Bitte Bereich auswählen", "Vergleichen", Selection.Address, Type:=8)
On Error GoTo 0
If Not rng Is Nothing Then
lngRowCount = rng.Rows.Count
lngColCount = rng.Columns.Count
rng.Interior.ColorIndex = xlNone
For lngRow = 1 To lngRowCount Step 2
For lngCol = 1 To lngColCount
bolCompare = True
bolCompare = rng.Cells(lngRow, lngCol) = rng.Cells(lngRow + 1, lngCol)
If bolCompare Then
For lngI = 1 To Len(rng.Cells(lngRow, lngCol).Text)
bolCompare = rng.Cells(lngRow, lngCol).Characters(lngI, 1).Font.Bold = _
rng.Cells(lngRow + 1, lngCol).Characters(lngI, 1).Font.Bold
If bolCompare Then bolCompare = rng.Cells(lngRow, lngCol).Characters(lngI, 1).Font.Italic = _
rng.Cells(lngRow + 1, lngCol).Characters(lngI, 1).Font.Italic
If bolCompare Then bolCompare = rng.Cells(lngRow, lngCol).Characters(lngI, 1).Font.Underline = _
rng.Cells(lngRow + 1, lngCol).Characters(lngI, 1).Font.Underline
If bolCompare Then bolCompare = rng.Cells(lngRow, lngCol).Characters(lngI, 1).Font.Superscript = _
rng.Cells(lngRow + 1, lngCol).Characters(lngI, 1).Font.Superscript
If bolCompare Then bolCompare = rng.Cells(lngRow, lngCol).Characters(lngI, 1).Font.Subscript = _
rng.Cells(lngRow + 1, lngCol).Characters(lngI, 1).Font.Subscript
If bolCompare Then bolCompare = rng.Cells(lngRow, lngCol).Characters(lngI, 1).Font.Strikethrough = _
rng.Cells(lngRow + 1, lngCol).Characters(lngI, 1).Font.Strikethrough
Next
End If
If Not bolCompare Then rng.Cells(lngRow, lngCol).Resize(2, 1).Interior.ColorIndex = 3
Next
Next
End If
Set rng = Nothing
End Sub