Ich bin leider inzwischen auf noch zwei Aufgaben gestoßen, bei denen ich nicht mehr weiter komme. Es wäre sehr hilfreich, wenn Sie mir bitte nochmal unter die Arme greifen könnten.
Erstelle eine benutzerdefinierte Funktion MITTLERELAENGE innerhalb von Microsoft Excel. Diese bekommt als Argument(e) beliebige Werte, Zellen und Zellbereichen übergeben und bestimmt die mittlere Zeichenlänge aller Parameter. Enthält ein Parameter gar keine Zeichen, so wird dieser ignoriert. Werden nur solche „leeren“ Parameter angegeben oder gar keine, liefert die Funktion den Wert 0 zurück.
Beispiel: In den Zellen A1 bis C2 stehen die rechts zu sehenden Werte: A1 = a1b2c3; A2 = Welt; B1 = 0,21; B2= -23; C1 = Hallo; C2 = leere Zelle
Der Aufruf =MITTLERELAENGE(123) liefert dann 3 als Ergebnis.
Der Aufruf =MITTLERELAENGE(A1) liefert dann 6 als Ergebnis.
Der Aufruf =MITTLERELAENGE(A1:C2) liefert dann 4,4 als Ergebnis (22 Zeichen / 5 nicht leere Parameter).
Der Aufruf =MITTLERELAENGE() liefert dann 0 als Ergebnis (keine Parameter).
Der Aufruf =MITTLERELAENGE(C2) liefert dann 0 als Ergebnis (nur leere Parameter).
Die erstellte Funktion soll im Funktionsassistenten in der Rubrik Mathematik und Trigonometrie erscheinen und einen erklärenden Text enthalten.
Mein Ansatz:
Option Explicit
Function MITTLERELAENGE(ParamArray Args() As Variant) As Variant
Dim i As Integer
Dim z As Integer
Dim s As String
Dim Zelle As Range
MITTLERELAENGE = 0
For i = LBound(Args) To UBound(Args)
If TypeName(Args(i)) = "Range" Then
' Zelle.value gibt Inhalt
For Each Zelle In Args(i)
For z = 1 To Len(CStr(Zelle.Value))
If Mid(CStr(Zelle.Value), z, 1) Like "*" Then
s = 1 + s
End If
Next
Next
If Not TypeName(Args(i)) = "Range" Then 'Typ überprüfen (mehrere Zellen oder einzelne)
'jede zelle im Array durchlafen
For z = 1 To Len(CStr(Args(i))) 'jedes Zeichen der Zelle durchlaufen
If Mid(CStr(Args(i)), z, 1) Like "*" Then 'überprüfen ob es sich an der Stelle um ein Zeichen handelt
s = s + 1 'Zählen von Zeichen
End If
Next
Else
MITTLERELAENGE = 0
End If
Next
MITTLERELAENGE = s
End Function
Sub SetFuncInfos()
Application.MacroOptions _
Macro:="MITTLERELAENGE", _
Description:="Bestimmung der mittleren Laenge", _
Category:=3
End Sub
|