Function AusbLevel() As Double
Dim Ausb As Double
Dim Zeile, Spalte As Double
Dim Bereich As Range
'Hier wird die akitive Zeile und Spalte ermittelt
Zeile = ActiveCell.Row
Spalte = 11 'Spalte K
Set Bereich = Range(Cells(Zeile, Spalte), Cells(Zeile, 75))
Ausb = 0 ' Level erreicht
For Each b In Bereich
If b.DisplayFormat.Interior.Color = 5287936 Then
Ausb = Ausb + 1
End If
Next b
AusbLevel = Ausb
End Function
Function FarbeCount(rng As Range) As Long
Dim Farbe As Long
Dim Zelle As Range
Dim Anzahl As Long
Farbe = 5287936
Anzahl = 0
For Each Zelle In rng
If Zelle.Interior.ColorIndex = Farbe Then
Anzahl = Anzahl + 1
End If
Next Zelle
FarbeCount = Anzahl
End Function
Sub Start()
Cells(ActiveCell.Row, 10) = FarbeCount(Intersect(ActiveCell.EntireRow, Range(Columns(11), Columns(75))))
End Sub
Function FarbeCount(rng As Range) As Long
Dim Farbe As Long
Dim Zelle As Range
Dim Anzahl As Long
Farbe = 5287936
Anzahl = 0
For Each Zelle In rng
If Zelle.Interior.ColorIndex = Farbe Then
Anzahl = Anzahl + 1
End If
Next Zelle
FarbeCount = Anzahl
End Function
Function Farbe(Zelle As Range) As Long
Dim txt As String
txt = "FarbeX('" & Zelle.Worksheet.Name & "'!" & Zelle.Address & ")"
Farbe = Evaluate(txt)
End Function
Function FarbeX(Zelle As Range) As Long
FarbeX = Zelle.DisplayFormat.Interior.Color
End Function
Function FarbeX(Zelle As Range) As Long
FarbeX = Zelle.DisplayFormat.Interior.Color
End Function
Function AusbLevel() As Long
Dim Zeile, Spalte As Long
Dim Bereich, Zelle As Range
Dim txt As String
Dim Farbe As Long
'Hier wird die akitive Zeile und Spalte ermittelt
Zeile = ActiveCell.Row
Spalte = 11 'Spalte K
Set Bereich = Range(Cells(Zeile, Spalte), Cells(Zeile, 75))
Ausb = 0 ' Level erreicht
For Each Zelle In Bereich
txt = "FarbeX('" & Zelle.Worksheet.Name & "'!" & Zelle.Address & ")"
Farbe = Evaluate(txt)
If Farbe = 5287936 Then
AusbLevel = AusbLevel + 1
End If
Next Zelle
End Function
Option Explicit
Function FarbeX(Zelle As Range) As Long
FarbeX = Zelle.DisplayFormat.Interior.Color
End Function
Function AusbLevel(Optional rng As Range = Nothing) As Long
Dim Zeile, Spalte As Long
Dim Bereich As Range, Zelle As Range
Dim txt As String
Dim Farbe As Long
Dim lngZ As Long
'Hier wird die akitive Zeile und Spalte ermittelt
Zeile = ActiveCell.Row
Spalte = 11 'Spalte K
If Not rng Is Nothing Then
Set Bereich = rng
Else
Set Bereich = Range(Cells(Zeile, Spalte), Cells(Zeile, 75))
End If
For Each Zelle In Bereich
txt = "FarbeX('" & Zelle.Worksheet.Name & "'!" & Zelle.Address & ")"
Farbe = Evaluate(txt)
If Farbe = 5287936 Then
lngZ = lngZ + 1
End If
Next Zelle
AusbLevel = lngZ
End Function
Function AusbLevel(Bereich as Range) As Long
Dim txt As String
Dim Farbe As Long
Dim Zelle as Range
AusbLevel = 0 ' Level erreicht
For Each Zelle In Bereich
txt = "FarbeX('" & Zelle.Worksheet.Name & "'!" & Zelle.Address & ")"
Farbe = Evaluate(txt)
If Farbe = 5287936 Then
AusbLevel = AusbLevel + 1
End If
Next Zelle
End Function
Function test() As String
Application.Volatile
test = Application.Caller.Address(0, 0) & " vs. " & ActiveCell.Address(0, 0)
End Function
Zelle.Interior.ColorIndex
Zelle.Interior.Color