Sehr umfangreiche benutzerdefinierte Funktionen sind auf eigene Modulblätter
geschrieben:
Diese können direkt in die Arbeitsmappen importiert werden.
Diese Funktionen werden in Excel wie Makros erstellt und bearbeitet.
Sie beginnen immer mit "Function funktion_xyz(yyy)".
In den Tabellenblättern werden sie wie folgt eingegeben:
=funktion_xyz(A1)
Hier verzichte ich mit Absicht auf die tabellarische Form wegen der Übersichtlichkeit.
Sehr umfangreiche benutzerdefinierte Funktionen sind auf eigene Modulblätter geschrieben:
Bildschirmauflösung
ausgeben
Ersteller: leider unbekannt
=ScreenResolution()
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Const HORZRES = 8
Const VERTRES = 10
Function ScreenResolution()
Dim lRval As Long
Dim lDc As Long
Dim lHSize As Long
Dim lVSize As Long
lDc = GetDC(0&)
lHSize = GetDeviceCaps(lDc, HORZRES)
lVSize = GetDeviceCaps(lDc, VERTRES)
lRval = ReleaseDC(0, lDc)
ScreenResolution = lHSize & "x" & lVSize
End Function
'Zum Testen im Direktfenster:
Sub GetScreenSize()
Debug.Print ScreenResolution()
End Sub
Zum einfachen Download
Benutzername anzeigen (Excelbenutzer)
=BenutzerName()
Function BenutzerName()
BenutzerName = Application.UserName
End Function
=BenutzerName1()
Function BenutzerName1()
BenutzerName1 = Environ("username")
End Function
=KWDatum(A1;HEUTE())
Kalenderwoche in Zelle A1;
aktuelles Kalenderjahr über Funktion "=heute()"
Function KWDatum(Kalenderwoche As Integer, Jahr As Date) As Date
tYear = DateSerial(Year(Jahr), 1, 1)
KWDatum = tYear + 1 - Application.WeekDay(tYear, 2) + (Kalenderwoche - 1) * 7
End Function
Kalenderwoche
Die in den Analysefunktionen enthaltene Funktion
"Kalenderwoche" entspricht nicht der deutschen DIN KW
Diese ist folgendermaßen definiert:
Der Wochenbeginn ist seit 1976 auf den Montag festgelegt. Die Erste
Kalenderwoche des Jahres muss mindestens 4 der ersten 7 Januartage enthalten
(dementsprechend: die Woche in die der 4.Januar fällt, ist die erste
Kalenderwoche). Dies wurde in der DIN 1355 im Jahre 1974 festgeschrieben.
Die ISO 8601 von 1988,
EN 28601 von 1992 und die
DIN EN28601 von 1993 sagen das gleiche aus.
=DINKw(A1)
Function DINKw(Tag)
DINKw = DatePart("ww", Tag, vbMonday,
vbFirstFourDays)
End Function
Schaltjahr
feststellen
Ein Schaltjahr ist wie folgt definiert:
Regel: Alle durch 4 teilbare Jahre ist ein Schaltjahr
1.Ausnahme: Außer es ist durch 100 teilbar.
2.Ausnahme: Außer es ist durch 400 teilbar, dann ist es doch ein Schaltjahr.
=Schaltjahr(A1)
Function Schaltjahr(Jahr)
J = Year(Jahr)
If (J Mod 4) = 0 And (J Mod 100) <> 0 Or (J Mod 400) =
0 Then
Schaltjahr = "Schaltjahr"
Else
Schaltjahr = "kein
Schaltjahr"
End If
End Function
Feiertage:
Ostern als Basis für bewegliche Feiertage
(Hier gibt es gleich 4 Varianten mit gleichem Ergebnis)
Ostern: Berechnungsgrundlagen: Bitte Link folgen
' von: Hans W. Herber
Public Function Ostern(Yr As Integer)
Dim D As Integer
D = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
Ostern = DateSerial(Yr, 3, 1) + D + (D > 48) + 6 - ((Yr + Yr \ 4 + D + (D > 48) + 1) Mod 7)
End Function
' von: Hans W. Herber
' siehe auch die Berechnungsgrundlagen
Function Ostern1(J%) As Date
Dim A%, B%, C%, D%, E%, M%, N%, P%
A = J Mod 19
B = J Mod 4
C = J Mod 7
M = 24
N = 5
D = (19 * A + M) Mod 30
E = (2 * B + 4 * C + 6 * D + N) Mod 7
P = 22 + D + E
If P > 31 Then
If P = 56 And D = 28 And A > 10 Then
Ostern1 = DateSerial(J, 4, 18)
ElseIf P = 57 Then
Ostern1 = DateSerial(J, 4, 19)
Else
Ostern1 = DateSerial(J, 4, P - 31)
End If
Else
Ostern1 = DateSerial(J, 3, P)
End If
End Function
' von: unbekannt
Function Ostern2(ByVal jahr As Integer) As Date
Dim ZR1 As Integer
Dim ZR2 As Integer
Dim ZR3 As Integer
Dim ZR4 As Integer
Dim ZR5 As Integer
Dim ZR6 As Integer
Dim ZR7 As Integer
ZR1 = jahr Mod 19 + 1
ZR2 = Fix(jahr / 100) + 1
ZR3 = Fix(3 * ZR2 / 4) - 12
ZR4 = Fix((8 * ZR2 + 5) / 25) - 5
ZR5 = Fix(5 * jahr / 4) - ZR3 - 10
ZR6 = (11 * ZR1 + 20 + ZR4 - ZR3) Mod 30
If (ZR6 = 25 And ZR1 > 11) Or _
ZR6 = 24 Then ZR6 = ZR6 + 1
ZR7 = 44 - ZR6
If ZR7 < 21 Then ZR7 = ZR7 + 30
ZR7 = ZR7 + 7
ZR7 = ZR7 - (ZR5 + ZR7) Mod 7
If ZR7 <= 31 Then
Ostern2 = DateSerial(jahr, 3, ZR7)
Else
Ostern2 = DateSerial(jahr, 4, ZR7 - 31)
End If
End Function
' von: Michael Kofler
' berechnet das Datum von Ostern für das angegebene Jahr
' nach einem Algorithmus von Gauss (funktioniert angeblich
' bis 2078; ich habe es aber nicht überprüft)
Function OsterDatum(jahr) As Date
Dim ZR1%, ZR2%, ZR3%, ZR4%, ZR5%, ZR6%, ZR7%
ZR1 = jahr Mod 19 + 1
ZR2 = Fix(jahr / 100) + 1
ZR3 = Fix(3 * ZR2 / 4) - 12
ZR4 = Fix((8 * ZR2 + 5) / 25) - 5
ZR5 = Fix(5 * jahr / 4) - ZR3 - 10
ZR6 = (11 * ZR1 + 20 + ZR4 - ZR3) Mod 30
If (ZR6 = 25 And ZR1 > 11) Or ZR6 = 24 Then ZR6 = ZR6 + 1
ZR7 = 44 - ZR6
If ZR7 < 21 Then ZR7 = ZR7 + 30
ZR7 = ZR7 + 7
ZR7 = ZR7 - (ZR5 + ZR7) Mod 7
If ZR7 <= 31 Then
OsterDatum = CDate(CStr(ZR7) & ". 3. " & CStr(jahr))
Else
OsterDatum = DateValue(CStr(ZR7 - 31) & ". 4. " & CStr(jahr))
End If
End Function
Feiertage berechnen und als Feiertagsname ausgeben
=Feiertag(A1)
=Feiertag(1.1.2001)
Zum einfachen Download
Function Feiertag(Datum As Date)
Dim J As Integer
Dim O As Date
J = Year(Datum)
O = Ostern(J)
Select Case Datum
Case Is = DateSerial(J, 1, 1)
Feiertag = "Neujahr"
Case Is = DateSerial(J, 1, 6)
Feiertag = "Dreikönig*"
Case Is = DateAdd("D", -2, O)
Feiertag = "Karfreitag"
Case Is = O
Feiertag = "Ostersonntag"
Case Is = DateAdd("D", 1, O)
Feiertag = "Ostermontag"
Case Is = DateSerial(J, 5, 1)
Feiertag = "Erster Mai"
Case Is = DateAdd("D", 39, O)
Feiertag = "Christi Himmelfahrt"
Case Is = DateAdd("D", 49, O)
Feiertag = "Pfingstsonntag"
Case Is = DateAdd("D", 50, O)
Feiertag = "Pfingstmontag"
Case Is = DateAdd("D", 60, O)
Feiertag = "Fronleichnam*"
Case Is = DateSerial(J, 8, 15)
Feiertag = "Maria Mimmelfahrt*"
Case Is = DateSerial(J, 10, 3)
Feiertag = "Deutsche Einheit"
Case Is = DateSerial(J, 10, 31)
Feiertag = "Reformationstag*"
Case Is = DateSerial(J, 11, 1)
Feiertag = "Allerheiligen*"
Case Is = DateSerial(J, 12, 24)
Feiertag = "Heilig Abend*"
Case Is = DateSerial(J, 12, 25)
Feiertag = "EWeihnacht"
Case Is = DateSerial(J, 12, 26)
Feiertag = "ZWeihnacht"
Case Is = DateSerial(J, 12, 31)
Feiertag = "Silvester*"
Case Else
Feiertag = ""
End Select
End Function
' von: Hans W. Herber
' wird zusätzlich benötigt
Public Function Ostern(Yr As Integer)
Dim D As Integer
D = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
Ostern = DateSerial(Yr, 3, 1) + D + (D > 48) + 6 - _
((Yr + Yr \ 4 + D + (D > 48) + 1) Mod 7)
End Function
=EUROinDM(A1)
=DMinEURO(A1)
Function DMinEURO(Geld)
DMinEURO = Geld / 1.95583
End Function
Function EUROinDM(Geld)
EUROinDM = Geld * 1.95583
End Function
Formel einer bestimmten Zelle anzeigen
=qFormel(A1)
Function qFormel(c)
qFormel = Right(c.FormulaLocal, Len(c.FormulaLocal) - 1)
End Function
Bestimmte Farbe in einem Bereich zählen
=FARBEZÄHLEN(Bereich;Farbnummer)
Farbnummernübersicht
=FARBEZÄHLEN(A1:E55;3)
Function FARBEZÄHLEN(Bereich As Range, Farbe As Byte)
Dim x As Long
For Each c In Bereich
If c.Interior.ColorIndex = Farbe Then x = x + 1
Next c
FARBEZÄHLEN = x
End Function
Beschreibungen
im Funktionsassistent für eigene Funktionen erstellen
von Bernd Held:
Schaut Euch dazu in der Hilfe die MacroOptions-Methode an.
Da gibt es einen Parameter der Description heißt.
Mit dem folgenden Makro kannst man eine benutzerdefinierte Funktion auch gleich
einer Kategorie zuordnen. Dabei kannst man dann auch eine Beschreibung machen.
Sub FunktionInAndereKategoriezuweisen()
Application.MacroOptions _ Macro:="test",
Description:="Test-Beschreibung", Category:=1
End Sub
Zum Testen:
Function Test()
MsgBox "Hallo"
End Function
Info: Aufschlüsselung der Kategorien:
Musterfunktion: Auf 5 Rappen runden (bzw. 0,05)
Zum einfachen Download
Beispieldatei mit praktischem Nutzwert:
Wird mit Makro in die Kategorie "Finanzmathematik" eingetragen.
Funktion rundet auf 0,05 auf bzw. ab.
Makro zum integrieren in Button dabei:
Funktionsassistent startet mit Hinweistext und normaler Zellauswahl.
Formatierung für Schweizer Franken wird für Zelle durchgeführt
G
Letzte Bearbeitung dieser Seite am 27.11.2004 23:40
