Hallo Clemens,

hab grad noch ein Problem entdeckt. In meinem ersten Beispiel werden leider nur die leeren Zellen "ignoriert", die sich außerhalb des UsedRange befinden. Sobald jedoch einmal ein Wert eingegeben und dann wieder gelöscht wurde, gilt die nun wieder leere Zelle als Unterschied zu den anderen Werten. Das Problem könntest du - zumindest theoretisch - mit folgender Erweiterung umgehen.

Public Function CompVals(Testrange As Range) As String
  If IsNull(Testrange.SpecialCells(xlCellTypeConstants).Text) Then CompVals = "Not Equal" Else CompVals = "All Equal"
End Function

bzw. falls du im Bereich FixWerte und Formeln gleichermaßen hast, dann so:

Public Function CompVals(TestRange As Range) As String
  On Error Resume Next
  Dim r1 As Range, r2 As Range
  Set r1 = TestRange.SpecialCells(xlCellTypeConstants)
  Set r2 = TestRange.SpecialCells(xlCellTypeFormulas)
  
  If Not r1 Is Nothing And Not r2 Is Nothing Then
    Set r1 = Union(r1, r2)
  ElseIf Not r2 Is Nothing Then
    Set r1 = r2
  ElseIf r1 Is Nothing And r2 Is Nothing Then
    Set r1 = TestRange
  End If
  
  If IsNull(r1.Text) Then CompVals = "not Equal" Else CompVals = "All Equal"
End Function

Beim Aufruf aus einer Sub heraus, gibts damit keine Probleme. Leider wird aber, zumindest bei mir, die SpecialCells-Methode bei Verwendung der Funktion als Worksheet-Function (also wenn der Caller eine Zelle ist) ignoriert. Das beweist die folgende Funktion:

Function Test(Bereich As Range)
  Test = Bereich.SpecialCells(xlCellTypeConstants).Address
End Function

Am Calculation-Modus kann es diesmal nicht liegen, denn andere Methoden wie z.B. .Offset oder .Resize funktionieren tadellos. Ein weiterer VBA-Bug für meine Sammlung! Microsoft-Programmierer, können eben auch nicht jede selten genutzte Kombination bedenken. Werde morgen mal testen, ob das Problem in neueren Versionen auch noch vorhanden ist.

Falls auch bei dir der Lösungsvorschlag nicht funktioniert bleibt wohl doch nur, die Kombination mit der langsamen Schleife. Bei größeren Bereichen mit Leerzellen oder ungleichen Werten musst du dann halt ein bisschen warten:

Public Function CompVals(TestRange As Range) As String
  If IsNull(TestRange.Text) Then
     For Each v In TestRange
        If v <> "" Then
           If Not IsEmpty(w) And v <> w Then
              CompVals = "Not Equal"
              Exit Function
           End If
        w = v
        End If
     Next
  End If
  CompVals = "All Equal"
End Function

Gruß Mr. K.