So hier die endgültige Lösung:
Erklärung:
Ich färbe alle Zellen am Anfang weiß.
Dann teste ich den Inhalt der Zellen auf Gleichheit und färbe die grün die gleich sind.
Code:
Option Explicit
Sub Vergleich()
Dim String1 As String
Dim String2 As String
Dim a As Integer
Dim b As Integer
Dim counter As Integer
Dim actdoc As Document
Set actdoc = ActiveDocument
Application.ScreenUpdating = False
counter = actdoc.Tables(1).Rows.Count
actdoc.Tables(1).Shading.BackgroundPatternColor = wdColorAutomatic
For a = 1 To counter
String1 = actdoc.Tables(1).Cell(a, 2).Range.Text
For b = (1 + a) To counter
String2 = actdoc.Tables(1).Cell(b, 2).Range.Text
If String1 = String2 Then
actdoc.Tables(1).Cell(b, 2).Shading.BackgroundPatternColor = wdColorBrightGreen
Else
End If
Next b
Next a
Application.ScreenUpdating = True
End Sub
Gruß
Jo.S
|