© Klaus-Martin Buss   www.kmbuss.de
Diese Seite ist Teil eines Framesets. Sollte links kein Navigationsmenü angezeigt werden, bitte hier klicken ...
 

UDF's (Benutzerdefinierte Funktionen)

Rückwärts (schreibt den inhalt einer Zelle rückwärts)
Ziffern (extrahiert alle Ziffern aus einem String)
Verbinden (verbindet Zellinhalte mit einem frei wählbaren Trennzeichen)
Textrechnen (berechnet einen String, der Rechenoperanden enthält)
Erstellt  -  Geändert  -  Gedruckt (Dateiinformationen)
Kommas (fügt nach jeweils x Stellen Kommas ein)
IsMailAddress (prüft, ob in der angegebenen Zelle eine Mailadresse vorhanden ist)
Formatierung (liest die Formatierung einer Zelle aus)
Schriftfarbe  -  Hintergrundfarbe (liest die Farbindizes aus)
Weblink (liest die Sprungadresse eines Hyperlinks aus)


T O P


 

UDF "Rückwärts"

Option Explicit

Function Rückwärts(Zelle As String)
Rückwärts = StrReverse(Zelle)
End Function
 

  A B C
1 Hans snaH Snah
2 UB40 04BU 04Bu
3 Neger regeN Regen
Formeln der Tabelle
B1 : =Rückwärts(A1)
C1 : =GROSS2(KLEIN(Rückwärts(A1)))
B2 : =Rückwärts(A2)
C2 : =GROSS2(KLEIN(Rückwärts(A2)))
B3 : =Rückwärts(A3)
C3 : =GROSS2(KLEIN(Rückwärts(A3)))

T O P


UDF "Ziffern"

Option Explicit

 

Function Ziffern(myString As String)
Dim i As Integer, j As Integer
Dim OnlyNums As String
For i = Len(myString) To 1 Step -1
If IsNumeric(Mid(myString, i, 1)) Then
j = j + 1
OnlyNums = Mid(myString, i, 1) & OnlyNums
End If
If j = 1 Then OnlyNums = CInt(Mid(OnlyNums, 1, 1))
Next i
Ziffern = CLng(OnlyNums)
End Function 

  A B
1 123Hans456 123456
2 Hauptstr. 6 a 6
3 UB40 40
4 12 Äpfel 12
Formeln der Tabelle
B1 : =Ziffern(A1)
B2 : =Ziffern(A2)
B3 : =Ziffern(A3)
B4 : =Ziffern(A4)

T O P


UDF "Verbinden"

Option Explicit

 

Public Function Verbinden(Trennzeichen As String, ParamArray Bereich() As Variant)
Dim vItem As Variant, rngCell As Range
Dim vRetVal As Variant
For Each vItem In Bereich
For Each rngCell In vItem.Cells
vRetVal = vRetVal & rngCell.Value & Trennzeichen
Next rngCell
Next vItem
Verbinden = Left$(vRetVal, Len(vRetVal) - Len(Trennzeichen))
End Function

  A B C D
1 1 12345 Hans Hans, Klaus, Ute, Klara
2 2 1+2+3+4+5 Klaus  
3 3 135 Ute  
4 4   Klara  
5 5      
Formeln der Tabelle
B1 : =Verbinden("";A1:A5)
D1 : =Verbinden(", ";C1:C4)
B2 : =Verbinden("+";A1:A5)
B3 : =Verbinden("";A1;A3;A5)

T O P


UDF "Textrechnen"
Option Explicit

Function Textrechnen(Text As String)
Textrechnen = Evaluate(Text)
End Function

  A B
1 1+2+3 6
2 3*7 21
3 (3+3)*4 24
4 3+3*4 15
Formeln der Tabelle
B1 : =Textrechnen(A1)
B2 : =Textrechnen(A2)
B3 : =Textrechnen(A3)
B4 : =Textrechnen(A4)

T O P


UDF's "Erstellt", "Geändert", "Gedruckt"
Option Explicit

Public Function Erstellt() As String
Application.Volatile
Erstellt = _
"Erstellt am " & ActiveWorkbook.BuiltinDocumentProperties("Creation Date") & " durch " & _
ActiveWorkbook.BuiltinDocumentProperties("Author")
End Function
'********************************************************************************
Public Function Geändert() As String
Application.Volatile
Geändert = _
"Zuletzt geändert am " & ActiveWorkbook.BuiltinDocumentProperties("Last Save Time") & " durch " & _
ActiveWorkbook.BuiltinDocumentProperties("Last Author")
End Function
'********************************************************************************
Public Function Gedruckt() As String
Application.Volatile
Gedruckt = _
"Zuletzt gedruckt am " & ActiveWorkbook.BuiltinDocumentProperties("Last Print Date") & " durch " & _
ActiveWorkbook.BuiltinDocumentProperties("Last Author")
End Function

  B
2 Erstellt am 10.06.2005 13:32:28 durch K.-M. Buss
3  
4 Zuletzt geändert am 01.05.2006 11:24:47 durch Klaus-Martin Buss
5  
6 Zuletzt gedruckt am 10.06.2005 13:44:21 durch Klaus-Martin Buss
Formeln der Tabelle
B2 : =Erstellt()
B4 : =Geändert()
B6 : =Gedruckt()

T O P


UDF "Kommas"
Option Explicit

Public Function Kommas(Zelle As Range, Stellen As Integer) As String
Dim i As Integer
Dim txt As String
Dim ktxt As String
txt = Zelle.Text
For i = 1 To Len(txt) Step Stellen
ktxt = ktxt & Mid(txt, i, Stellen) & ","
Next i
Kommas = Left(ktxt, Len(ktxt) - 1)
End Function

  A B
1 0102030405060708091011121314151617181920 010203,040506,070809,101112,131415,161718,1920
2 abcdefghijkl abc,def,ghi,jkl
3 A1B2C3D4E5F6 A1,B2,C3,D4,E5,F6
Formeln der Tabelle
B1 : =Kommas(A1;6)
B2 : =Kommas(A2;3)
B3 : =Kommas(A3;2)


T O P

 



UDF "IsMailAddress"
Option Explicit


Function IsMailAddress(z As String) As Boolean
Dim i As Integer
IsMailAddress = True
i = InStr(z, "@")
If i = 0 Then IsMailAddress = False: Exit Function
z = Mid(z, i + 1)
If InStr(z, "@") <> 0 Then IsMailAddress = False: Exit Function
i = InStr(z, ".")
If i < 2 Then IsMailAddress = False: Exit Function
z = Mid(z, i + 1)
If Len(z) < 2 Or Len(z) > 5 Then IsMailAddress = False: Exit Function
End Function

  A B
1 excel2000lex@aol.com WAHR
2 A@b FALSCH
3 A@b.de WAHR
4 A@b.cdefgh FALSCH
Formeln der Tabelle
B1 : =IsMailAddress(A1)
B2 : =IsMailAddress(A2)
B3 : =IsMailAddress(A3)
B4 : =IsMailAddress(A4)

T O P


UDF "Formatierung"
Option Explicit

Function Formatierung(Zelle As Range) As String
Formatierung = Zelle.NumberFormatLocal
End Function

  A B C D E
1 3 Test 21.02.2005 € 13,26 Das Jahr hat 12 Monate.
2 Standard Standard TT.MM.JJJJ "€ "#.##0,00 "Das Jahr hat "0" Monate."
Formeln der Tabelle
A2 : =Formatierung(A1)
B2 : =Formatierung(B1)
C2 : =Formatierung(C1)
D2 : =Formatierung(D1)
E2 : =Formatierung(E1)

T O P



UDF's "Schriftfarbe", "Hintergrundfarbe"
Option Explicit

 

Function Schriftfarbe(Zelle As Range) As Long
Schriftfarbe = Zelle.Font.ColorIndex
End Function
'***************************************
Function Hintergrundfarbe(Zelle As Range) As Long
Hintergrundfarbe = Zelle.Interior.ColorIndex
End Function 

  A B C D E F G H
1                
2                
3                
4         Türkis 8    
5                
6                
7                
8                
9                
10       16        
11                
12                
13                
14                
15                
16       Test 3, 6      
17                
18                
19                
Formeln der Tabelle
F4 : =schriftfarbe(E4)
D10 : =Hintergrundfarbe(C10)
E16 : =Hintergrundfarbe(D16)&", "&schriftfarbe(D16)

 

T O P


UDF "Weblink"
Option Explicit

Public Function Weblink(Zelle As Range)
Application.Volatile
Weblink = Zelle.Hyperlinks(1).Address
End Function
 

  AB CD E
1     
2  Suche bei GOOGLEhttp://www.google.de/http://www.google.de/ 
3     
4  Das MS-Excel-2000-Lexikonhttp://www.kmbuss.de/Excel-CD/index.htmhttp://www.kmbuss.de/Excel-CD/index.htm 
5     
6  ..\Excel-CD\Pics\LOGO01.JPG..\Excel-CD\Pics\LOGO01.JPG..\Excel-CD\Pics\LOGO01.JPG 
7     

Formeln der Tabelle
ZelleFormel
C2=Weblink(B2)
D2=HYPERLINK(Weblink(B2))
C4=Weblink(B4)
D4=HYPERLINK(Weblink(B4))
C6=Weblink(B6)
D6=HYPERLINK(Weblink(B6))

T O P


Stand: 02.02.10           (wird fortgesetzt ...)
© 2003 Crocodil Entertainment Klaus-Martin Buss