Hallo,

habe eine Arbeitsmappe erstellt.

Diese kannst Du hier herunterladen: https://www.dropbox.com/s/6aacow37gtsnoxr/Bedingte%20Formatierung%20Daten.xlsm?dl=0

Bei dieser Lösung habe i ch einen Ansatz gewählt, bei der direkt nach dem Ändern einer Zelle in der Daten-Tabelle die Zelle geprüft wird.

Modul modTypes:

Public Type Grenzwerte
    Sollwert As Long
    ToleranzOben As Long
    ToleranzUnten As Long
    Durchmesser As String
End Type

Tabelle Daten:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myCnf As New clsConfig
    Application.EnableEvents = False
    Dim Data As Grenzwerte
    Data = myCnf.ReadGrenzwerte(Target)
    
    If Target.Value = "" Then
        Target.Interior.ColorIndex = 15
    Else
        If Data.Durchmesser = "aussen" Then
            Target.Interior.ColorIndex = 38 ' rot
            If Target.Text <= Data.Sollwert + Data.ToleranzOben And Target.Text >= Data.Sollwert + Data.ToleranzUnten Then Target.Interior.ColorIndex = 10 ' grün
            If Target.Text > Data.Sollwert + Data.ToleranzOben Then Target.Interior.ColorIndex = 36 ' gelb
        ElseIf Data.Durchmesser = "innen" Then
            If Target.Text = "" Then
                Target.Interior.ColorIndex = 15 ' leere Zelle grau färben
            Else
                Target.Interior.ColorIndex = 38 'rot
                If Target.Text <= (Data.Sollwert + Data.ToleranzOben) And Target.Text >= (Data.Sollwert + Data.ToleranzUnten) Then Target.Interior.ColorIndex = 10 'grün
                If Target.Text < (Data.Sollwert + Data.ToleranzUnten) Then Target.Interior.ColorIndex = 36 'gelb
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Klasse clsConfig:

Private Function GetDataRange() As Range
    With Worksheets("Einstellungen")
        Set GetDataRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 5))
    End With
End Function

Function ReadGrenzwerte(Target As Range) As Grenzwerte
    Dim rngData As Range
    Dim rngCells As Range
    Dim rngRead As Range
    Set rngData = GetDataRange
    For Each rngCells In rngData.Columns(1).Cells
        If Left(rngCells.FormulaR1C1, 1) = "=" Then
            If Not Intersect(Range(rngCells.FormulaLocal), Target) Is Nothing Then
                For Each rngRead In Intersect(rngData, rngCells.EntireRow).Cells
                    Select Case rngRead.Column
                        Case 2
                            ReadGrenzwerte.Sollwert = rngRead.Value
                        Case 3
                            ReadGrenzwerte.ToleranzOben = rngRead.Value
                        Case 4
                            ReadGrenzwerte.ToleranzUnten = rngRead.Value
                        Case 5
                            ReadGrenzwerte.Durchmesser = rngRead.Value
                        Case Else
                    End Select
                Next
                Exit For
            End If
        End If
    Next
End Function

Damit diese Lösung funktioniert, muss in der Tabelle "Einstellungen" folgende Inhalte eingefügt werden:

Die Werte können natürlich angepasst werden.

Im Feld Spalte muss ein Verweis zu der Spalte eingesetzt werden:

Bsp: A2: =Daten!A:A
A3: =Daten!B:B

In der Tabelle "Daten" stehen nur noch die auszuwertenden Zahlen wie Bsp.:

Die Tabelle 1 wird nicht benötigt. Diese wrde nur als Testtabelle eingefügt, um zu sehen, wie der VBA-Code funktioniert

LG, BigBen