Excelfunktionen:

in VBA erstellte Funktionen können unter Excel genutzt werden.

Bedingung:  - Die Funktion muss auf Modulebene stehen !!!!!!!!!!!!

Beispiel:

 
Bekanntgabe der Funktion an den Funktions-Assistenten  


 
Beispiele 1 Beschreibung
Function Addition(A, B)
'+----------------------------------------------------------------------------------------------------------+
'|  Diese Funktion addiert die beiden übergebenen Argumente ( Variablen )                                   |
'+----------------------------------------------------------------------------------------------------------+
'|  Merke:                                                                                                  |
'|  - Der Funktionsname darf keine Leerzeichen und Sonderzeichen enthalten                                  |
'|  - Der Unterstrich ( _ ) ist allerdings erlaubt und kann als Ersatz für ein Leerzeichen benutzt werden.  |
'|  - Zahlen sind im Funktionsnamen erlaubt, aber nicht am Anfang !!                                        |
'|  - Die zulässige Länge eines Funktionsnamen beträgt max. 256 Zeichen                                     |
'|  - In den Funktionsnamen selbst wird das Berechnungsergebnis zugewiesen                                  |
'|                                                                                                          |
'|  - Übergebene Argumente können, müssen aber nicht als Variablen deklariert werden.                       |
'+----------------------------------------------------------------------------------------------------------+
    Application.Volatile   ' Nach jeder Eingabe wird diese Funktion neu berechnet
   
    Addition = A + B
End Function
Beispiele 2  
Function Multiplikation(Zahl1, Zahl2)
'+--------------------------------------------+
'|  Multiplikation zweier übergebenen Zahlen  |
'+--------------------------------------------+
    Multiplikation = Zahl1 + Zahl2
End Function
Beispiele 3  
Function Pythagoras(A, B)
'+-----------------------------------------------------------------------------+
'|  Berechnung der Hypotenuse ( längere Seite eines rechtwinkligen Dreiecks )  |
'+-----------------------------------------------------------------------------+
'|  Merke: - Es gelten die gleichen Berechnungsschreibweisen wie unter Excel.  |
'|         - Potenziert wird mit dem Dachzeichen (^).                          |
'|         - Die Quadratwurzel wird mir dem Befehl Sqr berechnet.              |
'|         - Eine n'te Wurzel wird wie folgt berechnet: a^(1/n).               |
'|           Beispiel: Berechnung der 5. Wurzel aus 123.                       |
'|                     123 ^ (1 / 5)                                           |
'+-----------------------------------------------------------------------------+
    Application.Volatile   ' Nach jeder Eingabe wird diese Funktion neu berechnet

    Pythagoras = Sqr(A ^ 2 + B ^ 2)
End Function
Beispiele 4  
Function KreisZahl()
'+--------------------------------------------------------+
'|  Ausgabe der Kreiszahl Pi                              |
'+--------------------------------------------------------+
'|  Merke: Excelfunktionen können über die Funktion:      |
'|         Application.WorksheetFunction.<Funktionsname>  |
'|         angezapft werden.                              |
'+--------------------------------------------------------+
    Application.Volatile   ' Nach jeder Eingabe wird diese Funktion neu berechnet
 

    KreisZahl = Application.WorksheetFunction.Pi
End Function
Beispiele 5  
Function SVERWEIS2(Suchwort As String, SuchSpalte, Tabelle As Range, AusgabeSpalte)
'+------------------------------------------------------------+
'|  Erweitert die Excelfunktion SVERWEIS dahin, dass:         |
'|  - die zu durchsuchende Spalte beliebig sein kann          |
'|  - Formate zwischen Suchwort und Tabelle ignoriert werden  |
'+------------------------------------------------------------+
   Dim Datenfeld As Variant
   Dim Zeile As Integer
   Dim Text As String

   Datenfeld = Tabelle.Value
   For Zeile = 1 To UBound(Datenfeld, 1)
       Text = Datenfeld(Zeile, SuchSpalte)
       If Suchwort = Text Then
          SVERWEIS2 = Datenfeld(Zeile, AusgabeSpalte)
          Exit Function
       End If
   Next Zeile
   SVERWEIS2 = ""
End Function
Beispiele 6  
Function Dez2Zahlensystem(Zahl, Basis)
'+------------------------------------------------------------+
'|  Umwandlung einer Dezimalzahl in ein anderes Zahlensystem  |
'+------------------------------------------------------------+
'|  Zahl = Deziamlzahl welche umgewandelt werden soll.        |
'|  Basis = Basiszahl des neuen Zahlensystems.                |
'|         2 --> Dualsystem                                   |
'|         8 --> Oktalsystem                                  |
'|        16 --> Hexadezimalsystem                            |
'+------------------------------------------------------------+
    Dim Anfang   As Byte
    Dim Bis      As Integer
    Dim Nr       As Integer
    Dim Zahl2    As Double
    Dim Zahl3    As Long
    Dim Ziffer   As Byte
    Dim Ziffern  As Variant

    Bis = Log(2 ^ 31 - 1) / Log(Basis)
    Zahl2 = Zahl
    Ziffern = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _
                    "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
                    "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", _
                    "U", "V", "W", "X", "Y", "Z")

    For Nr = 0 To Bis
        If Zahl2 > 0 Then
           Ziffer = (Zahl2 / Basis - Int(Zahl2 / Basis)) * Basis
           Zahl2 = Int(Zahl2 / Basis)
           Dez2Zahlensystem = Ziffern(Ziffer) & Dez2Zahlensystem
        End If
    Next Nr
End Function
Beispiele 7  
Function Zahlensystem2Dez(Zahl As String, Basis) As Long
'+----------------------------------------------------------------------------+
'|  Umwandlung Zahl aus einem anderen Zahlensystem in eine einer Dezimalzahl  |
'+----------------------------------------------------------------------------+
'|  Zahl = Deziamlzahl welche umgewandelt werden soll.                        |
'|  Basis = Basiszahl des neuen Zahlensystems.                                |
'|           2 --> Dualsystem                                                 |
'|           8 --> Oktalsystem                                                |
'|          16 --> Hexadezimalsystem                                          |
'+----------------------------------------------------------------------------+
    Dim Nr       As Integer
    Dim Ziffer   As Byte
    Dim Ziffern  As Variant

    Ziffern = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _
                    "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
                    "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", _
                    "U", "V", "W", "X", "Y", "Z")

    For Nr = Len(Zahl) To 1 Step -1
        For Ziffer = 0 To 35
            If Mid(Zahl, Nr, 1) = Ziffern(Ziffer) Then Exit For
        Next Ziffer
        Zahlensystem2Dez = Zahlensystem2Dez + Ziffer * Basis ^ (Len(Zahl) - Nr)
    Next Nr
End Function
Beispiele 8  
Function Dez2ABC(Zahl)
'+-------------------------------------------------------------+
'|  Umwandlung einer Dezimalzahl in eine alphanumerische Zahl  |
'+-------------------------------------------------------------+
'|  Zahl = Dezimalzahl welche umgewandelt werden soll.         |
'+-------------------------------------------------------------+
    Dim Anfang      As Byte
    Dim Bis         As Integer
    Dim I           As Integer
    Dim Nr          As Integer
    Dim VerglZahl   As Long
    Dim Zahl2       As Double
    Dim Ziffer      As Byte
    Dim Ziffern     As Variant

    Bis = Log(2 ^ 31 - 1) / Log(26) - 1
    Zahl2 = Zahl
    Ziffern = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
                        "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", _
                        "U", "V", "W", "X", "Y", "Z")

    For Nr = Bis To 0 Step -1
        If Zahl2 > 26 ^ Nr Then
           Ziffer = Int((Zahl2) / 26 ^ Nr)
           Zahl2 = Zahl2 - Ziffer * 26 ^ Nr
           Dez2ABC = Dez2ABC & Ziffern(Ziffer)
        Else
           If Zahl2 = 26 ^ Nr Then
              Ziffer = Zahl2
              Dez2ABC = Dez2ABC & Ziffern(Zahl2)
              Nr = Nr - 1
           End If
        End If
    Next Nr
End Function
Beispiele 9  
Function ABC2Dez(ABC As String)
'+-------------------------------------------------------------+
'|  Umwandlung einer alphanumerische Zahl in eine Dezimalzahl  |
'+-------------------------------------------------------------+
'|  Zahl = Deziamlzahl welche umgewandelt werden soll.         |
'+-------------------------------------------------------------+
    Dim Nr        As Integer
    Dim Ziffer    As Byte
    Dim Ziffern   As Variant

    Ziffern = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
                        "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", _
                        "U", "V", "W", "X", "Y", "Z")

    For Nr = Len(ABC) To 1 Step -1
        For Ziffer = 1 To 26
            If Mid(ABC, Nr, 1) = Ziffern(Ziffer) Then Exit For
        Next Ziffer
        ABC2Dez = ABC2Dez + Ziffer * 26 ^ (Len(ABC) - Nr)
    Next Nr
End Function
Beispiele 10  
Function UniCode(Zeichen As String)
'+-------------------------------------------------+
'|  Gibt den Unicode des angegebenen Zeichens aus  |
'+-------------------------------------------------+
    UniCode = AscW(Zeichen)
End Function
Beispiele 11  
Function UniZeichen(Code As Long)
'+-------------------------------------------------+
'|  Gibt das Zeichen des angegebenen Unicodes aus  |
'+-------------------------------------------------+
    UniZeichen = ChrW(Code)
End Function
Beispiele 12  
Function VektorBetrag(Ax, Ay, Az)
'+----------------------------------------+
'|  Gibt den Betrag eines 3D-Vektors aus  |
'+----------------------------------------+
'|  Ax = X-Anteil des Vektors             |
'|  Ay = Y-Anteil des Vektors             |
'|  Az = Z-Anteil des Vektors             |
'+----------------------------------------+
    VektorBetrag = Sqr(Ax ^ 2 + Ay ^ 2 + Az ^ 2)
End Function
Beispiele 13  
Function TextSumme(Bereich As Range, Separator As String)
'+---------------------------------------------------------------+
'|  Verkettet alle Einträge im 'Bereich' als neuen Text.         |
'|  Zwischen den Einträgen kann ein Separator eingesetzt werden  |
'+---------------------------------------------------------------+
    Dim Text As String
    Dim Zelle As Object

    For Each Zelle In Bereich
        If TextSumme > "" Then TextSumme = TextSumme & Separator
        TextSumme = TextSumme & Zelle.Value2
    Next Zelle
End Function
Beispiele 14  
Function ZeichenZählen(Text, Zeichen, Optional GK = True)
'+------------------------------------------------------+
'|  Zählt das Vorkommen eines Zeichens in einem Text    |
'+------------------------------------------------------+
'|  Text    = zu analysierender Text                    |
'|  Zeichen = soll im Text gesucht und gezählt werden.  |
'|  GK      = Groß/Klein-Schreibung                     |
'|            True --> wird beachtet                    |
'|            False --> wird nicht beachtet             |
'+------------------------------------------------------+
    Dim Pos As Integer      ' Schleifenzähler

    For Pos = 1 To Len(Text)
        If GK = True Then
           If Zeichen = Mid(Text, Pos, 1) Then ZeichenZählen = ZeichenZählen + 1
        Else
           If UCase(Zeichen) = UCase(Mid(Text, Pos, 1)) Then ZeichenZählen = ZeichenZählen + 1
        End If
    Next Pos
End Function
Beispiele 15  
Function RelevanteZeichen(Text, Optional GK = True)
'+------------------------------------------------------+
'|  Es sollen alle in einem Text vorkommenden Zeichen   |
'|  alphabetsich sortiert wiedergegeben werden.         |
'+------------------------------------------------------+
'|  Text    = zu analysierender Text                    |
'|  Zeichen = soll im Text gesucht und gezählt werden.  |
'|  GK      = Groß/Klein-Schreibung                     |
'|            True --> wird beachtet                    |
'|            False --> wird nicht beachtet             |
'+------------------------------------------------------+
    Dim Pos                     As Integer    ' Schleifenzähler
    Dim AnsiZeichen(0 To 255)   As Integer

    For Pos = 1 To Len(Text)
        If GK = True Then
           AnsiZeichen(Asc(Mid(Text, Pos, 1))) = 1
        Else
           AnsiZeichen(Asc(UCase(Mid(Text, Pos, 1)))) = 1
        End If
    Next Pos
    For Pos = 0 To 255
        If AnsiZeichen(Pos) > 0 Then
           RelevanteZeichen = RelevanteZeichen & Chr(Pos)
        End If
    Next Pos
End Function
Beispiele 16  
Function QGleichung(a, b, c, Optional Ergebnis = 1)
'+------------------------------------------------------------------------+
'|  Berechnung einer quadratischen Gleichung der Form: ax² + bx + c = 0   |
'+------------------------------------------------------------------------+
'|  a        = Konstante von x²                                           |
'|  b        = Konstante von x                                            |
'|  c        = Konstante                                                  |
'|  Ergebnis = optionaler Wert                                            |
'|             1 oder nicht angegeben --> 1. Lösungsmöglichkeit           |
'|             jeder andere Wert --> 2. Lösungsmöglichkeit                |
'+------------------------------------------------------------------------+
    If Ergebnis = 1 Then
       QGleichung = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)
    Else
       QGleichung = -(-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)
    End If
End Function
Beispiele 17  
Function QuadratGleich(a, b, c)
'+------------------------------------------------------------------------+
'|  Berechnung einer quadratischen Gleichung der Form: ax² + bx + c = 0   |
'+------------------------------------------------------------------------+
'|  Das Ergebnis ist eine 2 x 1 Matrix,                                   |
'|  d.h um alle Ergebnisse zu erhalten muss wie folgt vorgegangen werden: |
'|  - 2 Zellen untereinander markieren.                                   |
'|  - Funktionstaste F2 drücken                                           |
'|  - diese Funktion schreiben                                            |
'|  - und die aktuelle Zelle mit STRG + SHIFT + RETURN verlassen !!       |
'+------------------------------------------------------------------------+
    Dim Ergebnis(1 To 2, 1 To 1) As Double

    Ergebnis(1, 1) = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)
    Ergebnis(2, 1) = -(-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)
    QuadratGleich = Ergebnis
End Function
 
Beispiele 18  
Function Primzahl(Zahl As Long) As String
'+----------------------------------------------------------------------------+
'|  Ermittelt, ob eine Zahl eine Primzahl ist ( WAHR ) oder nicht ( FALSCH )  |
'+----------------------------------------------------------------------------+
    Dim Nr As Long                        ' Schleifenzähler

    Primzahl = "Primzahl"                 ' Wiedergabewert vorbesetzen
    For Nr = 2 To Sqr(Zahl)               ' Überprüfung ob Zahl durch Nr ganzzahlig teilbar ist
        If Zahl Mod Nr = 0 Then           ' Wenn der Rest der Division Zahl/Nr = 0 ist
           Primzahl = "keine Primzahl"    ' Rückgabewert setzen
           Exit Function                  ' Funktion verlassen
        End If
    Next Nr
End Function
Beispiele 19  
Function Primzahl2(Zahl) As String
'+------------------------------------------------------+
'|  Ermittelt, ob eine Zahl eine Primzahl ist ( WAHR ). |
'|  Wenn die Zahl keine Primzahl ist, werden die        |
'|  ganzzahligen Teiler der Zahl ausgegeben.            |
'+------------------------------------------------------+
    Dim Nr As Long

    Primzahl2 = "Primzahl"
    For Nr = Sqr(Zahl) To 2 Step -1
        If Zahl Mod Nr = 0 Then
           If Primzahl2 = "Primzahl" Then
              If Nr = Zahl / Nr Then
                 Primzahl2 = Nr
              Else
                 Primzahl2 = Nr & " | " & Zahl / Nr
              End If
           Else
              Primzahl2 = Nr & " | " & Primzahl2 & " | " & Zahl / Nr
           End If
        End If
    Next Nr
End Function
Beispiele 20  
Function LottoZahlen() As String
'+------------------------------------------------------------------------+
'|  Ausgabe von 6 Lottozahlen, welchen durch ein |-Zeichen getrennt sind  |
'+------------------------------------------------------------------------+
    Dim Nr     As Integer
    Dim Text   As String
    Dim Zahl   As Integer

    Nr = 1
    Do
      Zahl = Rnd * 49 + 0.5                                   ' Lottozahl erstellen
      If InStr(1, Text, Zahl) = 0 Then                        ' Überprüfung ob die Zahl bereits vorhanden ist
         Text = IIf(Len(Text) = 0, Zahl, Text & " | " & Zahl)
         Nr = Nr + 1
      End If
    Loop Until Nr > 6

    LottoZahlen = TextzahlenSortieren(Text, "|")              ' Ermittelte Zahlen sortieren
End Function

Function TextzahlenSortieren(Text, Separator)
'+-------------------------------------------------------------------------------+
'|  Sortiert einen Text nach Zahlen, welche durch einen Seperator getrennt sind  |
'+-------------------------------------------------------------------------------+
'|  Text = der zu sortiederende Text                                             |
'|  Separator = Trennzeichen zwischen den zu sortiederenden Texten               |
'+-------------------------------------------------------------------------------+
'|  Beispiel: Text = "7|3|9|1" Seperator ="|"                                    |
'|  Ergebnis: Text = "1|3|7|9"                                                   |
'+-------------------------------------------------------------------------------+
    Dim Dummy As Single
    Dim Nr As Integer
    Dim Sortiert As Boolean
    Dim TextZahlen As Variant

    TextZahlen = Split(Text, Separator)
    ReDim Zahlen(LBound(TextZahlen) To UBound(TextZahlen)) As Single

    For Nr = LBound(TextZahlen) To UBound(TextZahlen)
        Zahlen(Nr) = TextZahlen(Nr)
    Next Nr

    Do 
      Sortiert = True
      For Nr = LBound(Zahlen) To UBound(Zahlen) - 1
          If Zahlen(Nr) > Zahlen(Nr + 1) Then
             Dummy = Trim(Zahlen(Nr))
             Zahlen(Nr) = Zahlen(Nr + 1)
             Zahlen(Nr + 1) = Dummy
             Sortiert = False
          End If
      Next Nr
    Loop Until Sortiert = True

    TextzahlenSortieren = Zahlen(LBound(Zahlen))
    For Nr = LBound(Zahlen) + 1 To UBound(Zahlen)
        TextzahlenSortieren = TextzahlenSortieren & " | " & Zahlen(Nr)
    Next Nr
End Function
Beispiele 21  
Option Base 1

Function DatumsUmformer(Text) As Date
'+----------------------------------------------------------------+
'|  Formatiert eine englische Datumsanweisung in die deutsche um. |
'|  Beispiel:  2010-Dec-19 --> 19.12.2010                         |
'+----------------------------------------------------------------+
    Dim Pos1        As Integer
    Dim Pos2        As Integer
    Dim Tag         As Integer
    Dim Monat       As Integer
    Dim MonatText   As String
    Dim Jahr        As Integer

    Dim MonateL As Variant
    Dim MonateK As Variant

    MonateK = Array("jan", "feb", "mar", "apr", "mai", "jun", "jul", "aug", "sep", "okt", "nov", "dez")
    MonateL = Array("january", "february", " march", "april", "may", _
                    "june", "july", "august", "september", "october", "november", "december")

    Pos1 = InStr(1, Text, "-")
    Pos2 = InStr(Pos1 + 1, Text, "-")

    Jahr = Left(Text, Pos1 - 1)
    MonatText = LCase(Mid(Text, Pos1 + 1, Pos2 - Pos1 - 1))
    For Monat = 1 To 12
        If MonatText = MonateK(Monat) Or MonatText = MonateL(Monat) Then Exit For
    Next Monat
    If Monat = 13 Then Exit Function
    Tag = Mid(Text, Pos2 + 1)

    DatumsUmformer = DateSerial(Jahr, Monat, Tag)
End Function
 
Beispiele 22  
Function Zahlwort(Zahl)
'+--------------------------------------------------------------------------------------------------+
'|  Verwandelt eine Zahl in ein Zahlwort                                                            |
'|  Beispiel:   789654  --> sieben-hundert-neun-und-achtzig-tausend sechs-hundert-vier-und-fünfzig  |
'+--------------------------------------------------------------------------------------------------+
    Dim EinerText       As String
    Dim EinerZahl       As String
    Dim HunderterText   As String
    Dim HunderterZahl   As String
    Dim ZehnerText      As String
    Dim ZehnerZahl      As String

    Dim Durchlauf       As Integer
    Dim Stelle          As Integer
    Dim TextZahl        As String
    Dim TeilText        As String
    Dim Ziffer          As Byte
    Dim Ziffern()       As Variant

    Ziffern = Array("null", "ein", "zwei", "drei", "vier", "fünf", "sechs", "sieben", "acht", "neun")
    TextZahl = Trim(Str(Zahl))
    For Stelle = Len(TextZahl) To 1 Step -3
        Durchlauf = Durchlauf + 1
        EinerZahl = Mid(TextZahl, Stelle, 1)
        EinerText = Ziffern(EinerZahl)
        TeilText = EinerText
        If Stelle > 1 Then
           ZehnerZahl = Mid(TextZahl, Stelle - 1, 1)
           ZehnerText = EinerText
           Select Case ZehnerZahl
                  Case 1: Select Case EinerZahl
                                 Case 0: ZehnerText = "zehn"
                                 Case 1: ZehnerText = "elf"
                                 Case 2: ZehnerText = "zwölf"
                                 Case Is > 2: ZehnerText = EinerText & "-zehn"
                          End Select
                  Case 2: ZehnerText = "zwanzig"
                          If EinerZahl > 0 Then ZehnerText = EinerText & "-und-" & ZehnerText
                  Case 3: ZehnerText = "dreißig"
                          If EinerZahl > 0 Then ZehnerText = EinerText & "-und-" & ZehnerText
                  Case Is > 3: ZehnerText = Ziffern(ZehnerZahl) & "zig"
                          If EinerZahl > 0 Then ZehnerText = EinerText & "-und-" & ZehnerText
            End Select
            TeilText = ZehnerText
        End If
        If Stelle > 2 Then
           HunderterZahl = Mid(TextZahl, Stelle - 2, 1)
           HunderterText = IIf(HunderterZahl > 0, Ziffern(HunderterZahl) & "-hundert", "")
           TeilText = HunderterText
           If Len(ZehnerText) > 0 And ZehnerText <> "null" Then TeilText = HunderterText & "-" & ZehnerText
        End If
        Select Case Durchlauf
               Case 1: Zahlwort = TeilText
               Case 2: If TeilText > "" Then Zahlwort = TeilText & "-tausend " & Zahlwort
               Case 3: If TeilText = "ein" Then TeilText = "eine"
                       Zahlwort = TeilText & "-millionen " & Zahlwort
               Case 4: If TeilText = "ein" Then TeilText = "eine"
                       Zahlwort = TeilText & "-milliarden " & Zahlwort
               Case 5: If TeilText = "ein" Then TeilText = "eine"
                       Zahlwort = TeilText & "-billionen " & Zahlwort
               Case 6: If TeilText = "ein" Then TeilText = "eine"
                       Zahlwort = TeilText & "-billiarden " & Zahlwort
               Case 7: If TeilText = "ein" Then TeilText = "eine"
                       Zahlwort = TeilText & "-trillionen " & Zahlwort
               Case 8: If TeilText = "ein" Then TeilText = "eine"
                       Zahlwort = TeilText & "-trilliarden " & Zahlwort
        End Select
    Next Stelle
End Function
Beispiele 23  
Function SummeBereich(Bereich As Range, Optional XteZeile = 1, Optional XteSpalte = 1) As Double
'+------------------------------------------------------------------+
'|  Summiert jede x'te-Zeile bzw. jede x'te Spalte eines Bereiches  |
'+------------------------------------------------------------------+
    Dim Zelle As Range

    Application.Volatile

    For Each Zelle In Bereich
        If (Zelle.Row - Bereich.Row) Mod XteZeile = 0 Then
           If (Zelle.Column - Bereich.Column) Mod XteSpalte = 0 Then
              If IsNumeric(Zelle) Then ' Addiert nur, wenn die Zelle eine Zahl enthält
                 SummeBereich = SummeBereich + Zelle
              End If
           End If
        End If
    Next Zelle
End Function