AW: Mittelwert aller Maxwerte ohne Hilfsspalte
14.04.2010 09:37:45
Andi
Hi Benjamin,
Function Test()
MsgBox MittelwertMaxwerte
End Function
Function MittelwertMaxwerte() As String
Dim i, n, k, LetzteSpalte, maxwert As Long
Dim arrMW() As Long
Dim sh As Object
Set sh = ThisWorkbook.Sheets("Nametabelle")
k = 0
For i = 1 To EFZVUIS(sh, 1) - 1 'Anzahl Tage ' i =1 entspricht Zeile 1
maxwert = CLng(Left(CStr(sh.Cells(i, 1)), 2))
LetzteSpalte = EFSVRIZ(sh, i) - 1
For n = 1 To LetzteSpalte '1 bis 8 Zeiten möglich n = 1 entspricht Spalte A
If n
If CLng(Left(CStr(sh.Cells(i, n)), 2))
maxwert = CLng(Left(CStr(sh.Cells(i, n + 1)), 2))
End If
End If
Next
If Not IsEmpty(maxwert) Then
ReDim Preserve arrMW(0 To k)
arrMW(k) = maxwert
k = k + 1
End If
maxwert = 0
Next
On Error Resume Next
i = UBound(arrMW())
If Err.Number 0 Then Exit Function
On Error GoTo 0
maxwert = 0
For k = 0 To i
maxwert = maxwert + arrMW(k)
Next
MittelwertMaxwerte = CStr(maxwert / (i + 1)) & ":00"
Set sh = Nothing
End Function
Public Function EFSVRIZ(ByVal DasTabBlatt As Worksheet, ByVal DieZeile As Long) As Long
'Keine ausgeblendeten Spalten im Bereich
'Weiterverwendung auf eingene Gefahr
' *** Erste Freie Spalte von Rechts in einer Zeile ***
'Gibt die erste Freie Spalte von rechts zurück.
'ist die Letzte Spalte belegt so wird - 1 zurückgegeben bei einem Fehler -2
Dim i As Long
On Error GoTo Fehler
With DasTabBlatt
If IsEmpty(.Cells(DieZeile, .Columns.Count)) Then
i = .Cells(DieZeile, .Columns.Count).End(xlToLeft).Column
If i = 1 Then
EFSVRIZ = IIf(IsEmpty(.Cells(DieZeile, i)), 1, 2)
Else
EFSVRIZ = i + 1
End If
Else
EFSVRIZ = -1
End If
End With
Exit Function
Fehler:
EFSVRIZ = -2
End Function
Public Function EFZVUIS(ByVal DasTabBlatt As Worksheet, ByVal DieSpalte As Integer) As Long
'Weiterverwendung auf eingene Gefahr
'Keine Zeilen ausgeblendet
' *** Erste Freie Zeile von unten in einer Spalte ***
'Gibt die erste Freie Zeile von unten zurück.
'ist die Letzte Zelle belegt so wird - 1 zurückgegeben bei einem Fehler -2
Dim i As Long
On Error GoTo Fehler
With DasTabBlatt
If IsEmpty(.Cells(.Rows.Count, DieSpalte)) Then
i = .Cells(.Rows.Count, DieSpalte).End(xlUp).Row
If i = 1 Then
EFZVUIS = IIf(IsEmpty(.Cells(i, DieSpalte)), 1, 2)
Else
EFZVUIS = i + 1
End If
Else
EFZVUIS = -1
End If
End With
Exit Function
Fehler:
EFZVUIS = -2
End Function
Anbei XLS.
https://www.herber.de/bbs/user/69074.xls
Gruß Andi