In der folgenden Funktion tritt in der zweiten Schleife (While) der o.g. Laufzeitfehler auf. Eine weiter Eingrenzung des Problems war mir nicht möglich.
Gruß, FS
Function RS_Stunden(kurz As String, F_zahl As Integer) As Double ' 04.04.2016
' Zählt die Realschulstunden von kurz
' Voraussetzungen: Alle Kürzel der UV stehen in Zeile 3
' Alle Kürzel beginnen in der 4. Spalte
' Es gibt 20 Worksheets für die Fächer; sonst muss die äußere Schleife angepasst werden
Dim t As Integer
Dim s As Integer
Dim std As Double
std = 0
s = 4
For t = 1 To 20 ' 20 Worksheets für die Fächer
While (Application.Worksheets(t).Cells(3, s) <> "#")
If Application.Worksheets(t).Cells(3, s) = kurz Then
For z = 4 To 100
If (Application.Worksheets(t).Cells(z, s).Font.Italic) Then 'Wenn der Zellinhalt kursiv
If (Application.Worksheets(t).Cells(z, s).Font.ColorIndex = 55) Then ' 55: Dunkelblau
std = std + Application.Worksheets(t).Cells(z, s) * (2 / 3) / F_zahl
Else
std = std + Application.Worksheets(t).Cells(z, s)
End If
End If
Next z
End If
s = s + 1
Wend
Next t
RS_Stunden = std
End Function |