Wenn Funktion

Function BereichPruefenAufWahr_RetAbisZ(myRange As Range) As Variant
'*** es kann als Range eine zusammenhängender Bereich
'*** einer Spalte angegeben werden
'***
'*** Vom Anfang bis zum Ende des Bereiches werden die
'*** Zellinhalte auf WAHR geprüft
'*** Ist keine Inhalt WAHR liefert die Funktion KEIN WERT WAHR
'*** Andernfalls liefert sie die Buchstaben A -Z,
'*** abhängig von der Fundstelle.
'*** Also wenn die 1.  Zelle der Wert WAHR enthält, liefert sie A
'*** Also wenn die 2.  Zelle der Wert WAHR enthält, liefert sie B
'*** Also wenn die 26. Zelle der Wert WAHR enthält, liefert sie Z
'***
'*** Ist der Bereich
'*** - nicht zusammenhängend
'***   gibt die Funktion BEREICH NICHT ZuSAMMENHAENGEND zurück
'*** - nicht in einer Spalte
'***   gibt die Funktion BEREICH ENTHAELT MEHR ALS EINE SPALTE zurück
'*** - größer als 26 Zellen
'***   gibt die Funktion BEREICH ENTHAELT MEHR ALS 26 ZELLEN zurück
'***
  
  Dim l_cnt As Long, Zelle As Range
  Dim f As Variant
  f = Array( _
        A, B, C, D, E, F, G, H, I, J, K, L, M, _
        N, O, P, Q, R, S, T, U, V, W, X, Y, Z)
  
 ->Pruefen, ob r ein zusammenhängender Bereich ist
  If myRange.Areas.Count > 1 Then
    BereichPruefenAufWahr_RetAbisZ = BEREICH NICHT ZuSAMMENHAENGEND
    Exit Function
  End If
  
 ->Pruefen, ob r in einer Spalte liegt
  If myRange.Columns.Count > 1 Then
    BereichPruefenAufWahr_RetAbisZ = BEREICH ENTHAELT MEHR ALS EINE SPALTE
    Exit Function
  End If
  
 ->Pruefen, ob r mehr als 26 Zellen beinhaltet
  If myRange.Count > 26 Then
    BereichPruefenAufWahr_RetAbisZ = BEREICH ENTHAELT MEHR ALS 26 ZELLEN
    Exit Function
  End If
  
 ->Rückgabe-Kennung KEIN WERT WAHR setzen
  BereichPruefenAufWahr_RetAbisZ = KEIN WERT WAHR
  
  l_cnt = -1
 ->Zellinhalte der Reihe nach prüfen
  For Each Zelle In myRange
    l_cnt = l_cnt + 1
   ->Inhalt WAHR ?
    If Zelle.Value = True Then
     ->Buchstabe für Rückgabe-Kennung setzen
      BereichPruefenAufWahr_RetAbisZ = f(l_cnt)
      Exit For
    End If
  Next
  Set Zelle = Nothing
End Function