Sub Vergleich()
Dim RngS As Range, rngI As Range
Dim x As Long
Const C_SollName As String = "dtmSoll"
Const C_IstName As String = "dtmIst"
With Range(C_SollName)
Set RngS = Range(.Cells(2), .Cells(2).End(xlDown))
End With
With Range(C_IstName)
Set rngI = Range(.Cells(2), .Cells(2).End(xlDown))
End With
For x = 1 To RngS.Cells.Count
Select Case rngI.Cells(x) - RngS.Cells(x)
Case Is > 0
With rngI.Cells(x).Interior
.ColorIndex = 4
.TintAndShade = 0.7
End With
Case Is < 0
With rngI.Cells(x).Interior
.ColorIndex = 3
.TintAndShade = 0.7
End With
Case Else
rngI.Cells(x).Interior.ColorIndex = xlNone
End Select
Next x
End Sub