Posts on Bernd Plumhoff

Verteilung nach Restmenge (Excel / VBA)

Mon, 01 Jun 2026 17:59:00 +0100

Abstract

Die Arbeit ausscheidender Mitarbeiter wird auf die verbliebenen gemäß ihrer bisherigen Leistung (gemessen am Budget) verteilt. Wie können Sie dies korrekt durchführen?

Ein einfacher Ansatz

Eine einfache Formel ist =RUNDEN(C3*$B$2/$C$2;2), die Sie von D3 nach D12 hinunterkopieren können:

Sie können die Anteile der ausscheidenden Mitarbeiter einfach in Spalte C löschen. Die Reihenfolge der Löschungen ist egal.

Der offensichtliche Nachteil besteht in einem möglichen Rundungsfehler, weil die Summe gerundeter Summanden nicht notwendig der gerundeten Summe der nicht gerundeten Summanden entspricht. Das obige Beispiel ergibt eine Differenz von 0,02.

Zuweisen von Arbeitseinheiten vermindert um geleistete (Excel / VBA)

Sun, 31 May 2026 14:44:00 +0100

Abstract

Wie können Sie Ihren Mitarbeitern Arbeitseinheiten fair zuweisen, wenn Sie bereits geleistete Arbeit berücksichtigen wollen?

Gelbe Zellen sind Eingabezellen, grüne zeigen Zwischenergebnisse, und blaue kennzeichnen endgültige Ergebnisse.

Hinweis: Sie müssen Units done in absteigender Reihenfolge eingeben.

In diesem Beispiel wurden bereits 90,6 Einheiten geliefert, aber 86 weitere Einheiten sollen 28 Lehrern noch zugewiesen werden. Ein fairer Anteil wäre für jeden Lehrer (90.6 + 86) / 28 = 6,3, aber 7 Lehrer haben bereits mehr als das geliefert.

sbNextFloat (VBA)

Sun, 31 May 2026 10:18:00 +0100

Example

Appendix Programmcode sbNextFloat

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbNextFloat(d As Double, Optional bUp As Boolean = True) As Double
'Returns the smallest double which is greater than the input (bUp = True)
'or the greatest double which is smaller than the input value (bUp = False).
'Source (EN): https://www.sulprobil.de/sbnextfloat_en/
'Source (DE): https://www.berndplumhoff.de/sbnextfloat_de/
'(C) (P) by Bernd Plumhoff 03-Oct-2010 PB V0.11
sbNextFloat = d - (2# * bUp + 1#) * CDbl("1e" & Right(Format(d, "." & _
              String(15, "0") & "E+000"), 4) - 15)
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

Erhöhe die geringste signifikante Ziffer (Excel)

Sun, 31 May 2026 10:17:00 +0100

Abstract

Wie können Sie die geringste signifikante Ziffer einer Zahl erhöhen?

Beispiel: Gegeben sei die Zahl 123,4567. Sie benötigen eine Funktion, um 0,0001 zu ermitteln und auf die gegebene Zahl zu addieren.

Lösung:

=10^(--RECHTS(TEXT(ABS(A1);"#.###############E+000"),4)+7-LÄNGE(TEXT(ABS(A1);"#.###############E+000")))

Download

Bitte den Haftungsausschluss im Impressum beachten.

Increment_Lowest_Significant_Digit.xlsx [10 KB Excel Datei, ohne jegliche Gewährleistung]

sbReducePoints (VBA)

Sun, 31 May 2026 02:28:00 +0100

Abstract

Falls Sie die Anzahl von Kurvenpunkten auf solche mit signifikanter Steigungsänderung reduzieren möchten:

Literatur

Falls dieser einfache Ansatz der Steigungsänderung nicht ausreicht, empfiehlt sich der (externer Link!) Douglas-Peucker-Algorithmus.

Appendix sbReducePoints Code

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbReducePoints(rX As Range, rY As Range, _
    Optional dMaxSlopeDelta As Double = 0.001) As Variant
'sbReducePoints eliminates points from a given set
'in case the slopes between these points do not differ
'too much.
'Source (EN): https://www.sulprobil.de/sbreducepoints_en/
'Source (DE): https://www.berndplumhoff.de/sbreducepoints_de/
'(C) (P) by Bernd Plumhoff 29-Mar-2023 PB V0.1

Dim bNewSlope               As Boolean

Dim dSlope12                As Double
Dim dSlope13                As Double
Dim dSlope23                As Double

Dim i                       As Long
Dim k                       As Long
Dim lcount                  As Long

With Application.WorksheetFunction

lcount = rX.Rows.Count
If rX.Columns.Count > lcount Then
    lcount = rX.Columns.Count
End If

ReDim dX(1 To lcount) As Double
ReDim dY(1 To lcount) As Double

'read data row-wise or column-wise
If rX.Rows.Count > rX.Columns.Count Then
    For i = 1 To lcount
        dX(i) = rX.Cells(i, 1)
        dY(i) = rY.Cells(i, 1)
    Next i
Else
    For i = 1 To lcount
        dX(i) = rX.Cells(1, i)
        dY(i) = rY.Cells(1, i)
    Next i
End If

ReDim vR(1 To 2, 1 To lcount) As Variant

vR(1, 1) = dX(1)
vR(2, 1) = dY(1)
vR(1, 2) = dX(2)
vR(2, 2) = dY(2)
k = 2
bNewSlope = True
For i = 3 To lcount
    If bNewSlope Then dSlope12 = (vR(2, k) - vR(2, k - 1)) / (vR(1, k) - vR(1, k - 1))
    dSlope13 = (dY(i) - vR(2, k - 1)) / (dX(i) - vR(1, k - 1))
    dSlope23 = (dY(i) - vR(2, k)) / (dX(i) - vR(1, k))
    If Abs(dSlope13 - dSlope12) > dMaxSlopeDelta Or _
        Abs(dSlope13 - dSlope23) > dMaxSlopeDelta Then
        k = k + 1
        bNewSlope = True
    Else
        bNewSlope = False
    End If
    vR(1, k) = dX(i)
    vR(2, k) = dY(i)
Next i
    
ReDim Preserve vR(1 To 2, 1 To k) As Variant

If rX.Rows.Count > rX.Columns.Count Then
    sbReducePoints = .Transpose(vR)
Else
    sbReducePoints = vR
End If

End With

End Function

Bitte den Haftungsausschluss im Impressum beachten.

sbDistBudget (VBA)

Sun, 31 May 2026 01:58:00 +0100

“Givers have to set limits because takers rarely do.” [Irma Kurtz]

Beispiel

Nehmen Sie, Ihr Unternehmen befindet sich mitten in seinem jährlichen Planungsprozess für Einnahmen und Ausgaben. Sie sind der Bereichsleiter von 6 Abteilungen (A bis F). Ihre Abteilungsleiter haben ein Budget von 2000, 1900, 2000, 2000, 600 und 2000 € beantragt, aber Ihnen wurde lediglich ein Gesamtbudget in Höhe von 9500 € zur Verfügung gestellt. Ihre Abteilungen tragen gewichtet 30%, 20%, 15%, 15%, 10% und 10% zu den Unternehmenseinnahmen bei.

Optimale Boxenstopps (VBA)

Sun, 31 May 2026 01:57:00 +0100

Abstract

Sie managen ein Autorennteam und wollen die optimalen Boxenstopps für ein Rennen planen?

Beispiel:

Appendix – Programmcode Optimale_Boxenstopps

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Sub optimale_boxenstopps()
'Berechnet optimale Boxenstopps für ein Autorennteam.
'Source (EN): https://www.sulprobil.de/optimal_pitstops_en/
'Source (DE): https://www.berndplumhoff.de/optimale_boxenstopps_de/
'(C) (P) by Bernd Plumhoff 01-Jan-2023 PB V0.2

Dim i                          As Long
Dim j                          As Long
Dim k                          As Long
Dim m                          As Long
Dim t                          As Long
Dim lRunden                    As Long

Dim dStartzeit                 As Double
Dim dRundenZeit                As Double
Dim dResetZeit                 As Double
Dim dZeitTotal                 As Double
Dim dZeitBest                  As Double
Dim dInkrement                 As Double
Dim dBoxenstopp                As Double

Dim sBoxenstopps               As String
Dim sComma                     As String
Dim sSemiColon                 As String

Dim state                      As SystemState 'Siehe https://www.berndplumhoff.de/systemstate_de/

Set state = New SystemState

lRunden = Range("Anzahl_Runden")
ReDim lIdx(1 To lRunden) As Long
dStartzeit = Range("Startzeit")
dResetZeit = Range("Resetzeit")
dInkrement = Range("Inkrement")
dBoxenstopp = Range("Boxenstopp")
Columns("E:G").ClearContents
Range("E4:G4").FormulaArray = Array("Anzahl Stopps", "Gesamtzeit [s]", "Stopps in Runde(n)")

For t = 0 To lRunden 'Anzahl der Boxenstopps
    dZeitBest = 1E+300
    ReDim c(1 To t + 2) As Long
    For j = 1 To t
        c(j) = j - 1
    Next j
    c(t + 1) = lRunden
    c(t + 2) = 0
    Do
        dZeitTotal = 0#
        dRundenZeit = dStartzeit
        For i = 1 To lRunden
            dZeitTotal = dZeitTotal + dRundenZeit
            For m = 1 To t
                If i = c(m) + 1 Then
                    dZeitTotal = dZeitTotal + dBoxenstopp
                    dRundenZeit = dResetZeit
                    Exit For
                End If
            Next m
            If m > t Then dRundenZeit = dRundenZeit + dInkrement
        Next i
        If (dZeitBest > dZeitTotal) Or (Abs(dZeitBest - dZeitTotal) < 0.000000001) Then
            If dZeitBest > dZeitTotal Then
                dZeitBest = dZeitTotal
                sBoxenstopps = ""
                sSemiColon = ""
            End If
            sComma = ""
            sBoxenstopps = sBoxenstopps & sSemiColon
            For m = 1 To t
                sBoxenstopps = sBoxenstopps & sComma & c(m) + 1
                sComma = ", "
            Next m
            sSemiColon = "; "
        End If
        j = 1
        Do While c(j) + 1 = c(j + 1)
            c(j) = j - 1
            j = j + 1
        Loop
        c(j) = c(j) + 1
    Loop Until j > t
    Cells(t + 5, 5) = t
    Cells(t + 5, 6) = dZeitBest
    Cells(t + 5, 7) = sBoxenstopps
Next t

Columns("E:G").EntireColumn.AutoFit
If Columns("G:G").ColumnWidth > 70 Then Columns("G:G").ColumnWidth = 70

End Sub

Download

Bitte den Haftungsausschluss im Impressum beachten.

Wahrscheinlichkeiten (Excel, VBA)

Sun, 31 May 2026 01:56:00 +0100

Abstract

Wenn Sie aus einem vollständigen Kartensatz von 52 Spielkarten 7 Karten ohne Zurücklegen ziehen, wie hoch ist die Wahrscheinlichkeit, dass Sie dann 3 Asse in der Hand halten?

Die Antwort lautet: etwa 0,58%

Die genaue Formel für die Wahrscheinlichkeit ohne Zurücklegen ist für Excel 365 oder Excel 2021

=WENNFEHLER(KOMBINATIONEN(Elements_Drawn;SEQUENZ(1;Elements_Same + 1;0;1)) * (Elements_Same/Elements_Total)^SEQUENZ(1;Elements_Same + 1;0;1) * WENNFEHLER((1 - Elements_Same/Elements_Total)^(Elements_Drawn-SEQUENZ(1;Elements_Same + 1;0;1));1);0)

Mit Zurücklegen lautet sie

=WENNFEHLER(KOMBINATIONEN(Elements_Same;SEQUENZ(1;Elements_Same + 1;0;1))*KOMBINATIONEN(Elements_Total - Elements_Same;Elements_Drawn-SEQUENZ(1;Elements_Same + 1;0;1))/KOMBINATIONEN(Elements_Total;Elements_Drawn); 0)

Dabei wurden folgende Namen definiert:

Hugo (HTML)

Sat, 30 May 2026 14:39:00 +0100

“I am always doing things I can’t do, that’s how I got to do them.” [Pablo Picasso]

Abstract

Ich betreibe keinen Webshop und benötige keine Datenbank oder automatische Aktualisierung von Webseiten. Deshalb habe ich meine Websites berndplumhoff.de und (externer Link!) sulprobil.de mit Hugo erstellt.

Hugo ist sehr effizient. Die Webseiten werden schnell übersetzt. Die generierten Webseiten werden schnell geladen und sind sowohl auf dem PC wie auch auf Smartphones gut zu lesen.

MiniMax Interpolation (Excel)

Fri, 29 May 2026 16:33:00 +0100

“The man of knowledge must be able not only to love his enemies but also to hate his friends.” [Friedrich Nietzsche]

Abstract

Alexander W. fand eine Interpolationsformel für Aufgabenstellungen, die häufig bei Steuern oder Provisionsberechnungen auftreten:

=MIN(C6%%*{110;70;35;25}+{0;400;1275;1775};3212,5)

Für das nachfolgende Beispiel wäre das Resultat 2.150 für den Eingabewert 250.000:

Wie berechnet man die Funktionsparameter und welches sind die Voraussetzungen oder Bedingungen unter denen diese Formel angewandt werden kann? Diese Formel kann genau dann verwendet werden, wenn die Funktion y = f(x) monoton ist, d. h. entweder monoton steigend oder monoton fallend:

Unterjährige Werte glätten (Excel)

Fri, 29 May 2026 02:06:00 +0100

Abstract

Sie wollen unterjährige Werte glätten und dabei die Periodenendwerte und den Gesamtdurchschnitt beibehalten?

Zwei einfache Möglichkeiten:

Definieren Sie diese Namen:

Name	Bezieht sich auf
All_Values	=Sheet1!$A$2:$K$2
Bookvalue_End	=Sheet1!$L$2
Bookvalue_Start	=Sheet1!$A$2
Inner_Count	=(Total_Count-2)
Inner_Values	=Sheet1!$B$2:$K$2
Total_Average	=MITTELWERT(All_Values)
Total_Count	=SPALTE(Bookvalue_End)-SPALE(Bookvalue_Start)+1

Wenn alle unterjährigen Werte identisch sein sollen, geben Sie ein:
A3: =Bookvalue_Start B3: =(@Total_Average*@Total_Count-Bookvalue_Start-Bookvalue_End)/@Inner_Count und nach rechts kopieren bis K3
L3: =Bookvalue_End

Wenn alle unterjährigen Werte (mit Ausnahme eines oder mehrerer Extremwerte) identisch sein sollen, geben Sie ein:
A3: =Bookvalue_Start
B3: =WENN(ABS(@Total_Average-MAX(Inner_Values))>=ABS(@Total_Average-MIN(Inner_Values));WENN(B$2=MAX(Inner_Values);B$2;(@Total_Average*@Total_Count-Bookvalue_Start-Bookvalue_End-MAX(Inner_Values)*ZÄHLENWENN(Inner_Values;MAX(Inner_Values)))/(@Inner_Count-ZÄHLENWENN(Inner_Values;MAX(Inner_Values))));WENN(B$2=MIN(Inner_Values);B$2;(@Total_Average*@Total_Count-Bookvalue_Start-Bookvalue_End-MIN(Inner_Values)*ZÄHLENWENN(Inner_Values;MIN(Inner_Values)))/(@Inner_Count-ZÄHLENWENN(Inner_Values;MIN(Inner_Values))))) und nach rechts kopieren bis K3
L3: =Bookvalue_End

sbORB (VBA)

Fri, 29 May 2026 01:51:00 +0100

“Every wall is a door.” [Ralph Waldo Emerson]

Abstract

Echtdaten enthalten manchmal extreme Werte, die Sie ignorieren oder löschen möchten, sogenannte Ausreißer:

Appendix Programmcode sbORB

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbORB(rY As Range, rX As Range, _
    Optional dSigmaFactor As Double = 3#, _
    Optional dMaxOutlierPercentage As Double = 0.5) As Variant
'sbORB() = outlier resistant beta returns a beta and
'an alpha where y = beta * x + alpha is most accurate
'for (almost) all given x in rX and y in rY.
'"Almost" means that we successively (one by one) throw out outliers
'which have a distance of > dSigmaFactor * STDEV_of_all_Distances
'from the least square (LS) proxy.
'Source (EN): https://www.sulprobil.de/sborb_en/
'Source (DE): https://www.berndplumhoff.de/sborb_de/
'(C) (P) by Bernd Plumhoff 24-Jun-2007 PB V0.9
Dim vLinEst As Variant 'store LinEst() result of recent LS proxy during iterations
Dim dm2 As Double 'ortogonal slope to recent LS proxy
Dim dc As Double 'Constant c in: y2=m2*x2+c which is ortogonal to LS proxy through a given point
Dim dx2 As Double 'x2 in: y2 = m2 * x2 + c which is ortogonal to LS proxy through a given point
Dim dy2 As Double 'y2 in: y2 = m2 * x2 + c which is ortogonal to LS proxy through a given point
Dim i As Long, j As Long
Dim lcount As Long 'holds current number of live points
Dim lcount_orig As Long 'original (starting) number of points
Dim lcount_old As Long 'holds number of live points of previous iteration
Dim daverage As Double 'average of distances to LS proxy of current iterations' live points
Dim dstdev As Double 'Stdev of distances to LS proxy of current iterations' live points
Dim dDistMax As Double
Dim lDistMaxIdx As Long

lcount = rX.Rows.Count
If rX.Columns.Count > lcount Then
    lcount = rX.Columns.Count
End If
lcount_orig = lcount
lcount_old = lcount + 1

ReDim dDist(1 To lcount) As Double 'store distances of live points to recent LS proxy (line)
ReDim dX(1 To lcount) As Double
ReDim dY(1 To lcount) As Double    'store coordinates of "live" points during iterations

'read data row-wise or column-wise
If rX.Rows.Count > rX.Columns.Count Then
    For i = 1 To lcount
        dX(i) = rX.Cells(i, 1)
        dY(i) = rY.Cells(i, 1)
    Next i
Else
    For i = 1 To lcount
        dX(i) = rX.Cells(1, i)
        dY(i) = rY.Cells(1, i)
    Next i
End If

Do
    lcount_old = lcount
    ReDim Preserve dDist(1 To lcount) As Double 'Store distances of live points to last LS proxy
    ReDim Preserve dX(1 To lcount) As Double
    ReDim Preserve dY(1 To lcount) As Double 'Store coordinates of "live" points during iterations
    vLinEst = Application.WorksheetFunction.LinEst(dY, dX, True, True)
    dDistMax = 0#
    lDistMaxIdx = 1
    For i = 1 To lcount
        'Calculate distances of live points to recent LS proxy
        dm2 = -1# / vLinEst(1, 1)
        dc = dY(i) - dX(i) * dm2
        dx2 = (dc - vLinEst(1, 2)) / (vLinEst(1, 1) - dm2)
        dy2 = dm2 * dx2 + dc
        dDist(i) = Sqr((dX(i) - dx2) * (dX(i) - dx2) + (dY(i) - dy2) * (dY(i) - dy2))
        'remember largest distance and its index
        If dDist(i) > dDistMax Then
            dDistMax = dDist(i)
            lDistMaxIdx = i
        End If
    Next i
    'calculate average and standard deviation of live points' distances to LS proxy
    daverage = Application.WorksheetFunction.Average(dDist)
    dstdev = Application.WorksheetFunction.StDev(dDist)
'    'kill points with distance > dSigmaFactor * dstdev 'Attention: might erase too many points
'    j = 1
'    For i = 1 To lcount
'        If dDist(i) <= dstdev * dSigmaFactor Then
'            dX(j) = dX(i)
'            dY(j) = dY(i)
'            j = j + 1
'        Else
'            Debug.Print "Lcount: " & lcount & ". Throwing out (" & dX(i) & ";" & dY(i) & ")"
'        End If
'    Next i
'    lcount = j - 1
    'kill point with largest distance > dSigmaFactor * dstdev
    If dDist(lDistMaxIdx) >= dstdev * dSigmaFactor Then
        Debug.Print "Lcount: " & lcount & ". Throwing out (" & dX(lDistMaxIdx) & _
                    ";" & dY(lDistMaxIdx) & ")"
        dX(lDistMaxIdx) = dX(lcount)
        dY(lDistMaxIdx) = dY(lcount)
        lcount = lcount - 1
    End If
Loop While lcount_old > lcount And lcount / lcount_orig > 1# - dMaxOutlierPercentage

If lcount < lcount_old Then
    vLinEst = Application.WorksheetFunction.LinEst(dY, dX, True, True)
End If

sbORB = vLinEst

End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbBirthdayList (VBA)

Fri, 29 May 2026 01:44:00 +0100

“Nice to be here? At my age, it’s nice to be anywhere.” [George Burns]

Sie wollen wissen, wann es wieder Zeit für Kuchen in Ihrem Team ist? Dann erstellen Sie eine Geburtstagsliste:

Beispiel

Appendix Programmcode sbBirthdayList

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbBirthdayList(r As Range) As Variant
'Create monthly birthday list.
'Source (EN): https://www.sulprobil.de/sbbirthdaylist_en/
'Source (DE): https://www.berndplumhoff.de/sbbirthdaylist_de/
'(C) (P) by Bernd Plumhoff 15-Sep-2010 PB V0.10
Dim vR(1 To 13, 1 To 3) As Variant
Dim i As Long, j As Long
Dim sNames(101 To 1231) As String

'Fill temporary array
For i = 1 To r.Rows.Count
    If IsDate(r.Cells(i, 2)) Then
        j = Month(r.Cells(i, 2))
        vR(j + 1, 2) = vR(j + 1, 2) + 1 'Increasing DOB counter for month
        j = j * 100 + Day(r.Cells(i, 2))
        If sNames(j) <> "" Then sNames(j) = sNames(j) & ", "
        sNames(j) = sNames(j) & r.Cells(i, 1)
    End If
Next i

'Fill output area
vR(1, 1) = "Month"
vR(1, 2) = "#"
vR(1, 3) = "(Day) Names"
For i = 1 To 12
    vR(i + 1, 1) = Format(DateSerial(1900, i, 1), "MMMM")
    vR(i + 1, 3) = ""
    For j = 1 To 31
        If sNames(i * 100 + j) <> "" Then
            If vR(i + 1, 3) <> "" Then vR(i + 1, 3) = vR(i + 1, 3) & ", "
            vR(i + 1, 3) = vR(i + 1, 3) & "(" & j & ") " & sNames(i * 100 + j)
        End If
    Next j
Next i

sbBirthdayList = vR

End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

Minimum Truck Load Problem (Excel)

Thu, 28 May 2026 05:55:00 +0100

Abstract

Angenommen, ein Lieferant verkauft seine Ware nur in gewissen Mindestmengen, um die Warenlieferungen wirtschaftlich zu gestalten. So könnte z. B. die erste Mindestmenge eine volle Wagenladung sein, und ab dem zweiten Wagen immer mindestens eine halbe Wagenladung.

Beispiel

Eine volle Wagenladung besteht aus 10 Waren. Dies ist die minimale Bestellmenge. Danach muss immer mindestens eine halbe Wagenladung bestellt werden. Es soll verhindert werden, dass ein Truck mit weniger als einer halben Ladung fährt.

ConvertTime (VBA)

Thu, 28 May 2026 05:52:00 +0100

Abstract

Julian Hess und Patrick Honorez entwickelten ein sehr gutes Konvertierprogramm für MS Access und für MS Excel, um die Zeit einer Zeitzone in eine andere zu übersetzen (externer Link!):

https://stackoverflow.com/questions/3120915/get-timezone-information-in-vba-excel/20489651#20489651

Bitte beachten Sie, dass hierfür ein ordentlich installiertes Outlook Voraussetzung ist.

sbDHondt (VBA)

Thu, 28 May 2026 05:44:00 +0100

Abstract

Wenn Sie die verfügbaren Parlamentssitze fair gemäß der erzielten Stimmen pro Partei verteilen wollen, können Sie die (externer Link!) D’Hondt Methode anwenden:

Literatur

Ein vergnügliches Büchlein ist:

N. Herrmann, Mathematik ist überall, Oldenbourg Verlag München Wien, ISBN 3-486-57583-X

Siehe Kapitel 12, Das Wahl-Problem.

Appendix Programmcode sbDHondt

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbdHondt(lSeats As Long, vVotes As Variant) As Variant
'Implements the d'Hondt method for allocating seats in
'party-list proportional representation political election
'systems.
'Source (EN): https://www.sulprobil.de/sbdhondt_en/
'Source (DE): https://www.berndplumhoff.de/sbdhondt_de/
'(C) (P) by Bernd Plumhoff 01-Dec-2009 PB V0.10
Dim i As Long, k As Long, n As Long
Dim vA As Variant, vB As Variant, vR As Variant
Dim dMax As Double

With Application.WorksheetFunction
vA = .Transpose(.Transpose(vVotes))
vB = vA
n = UBound(vA, 1)
ReDim vR(1 To n, 1 To 1) As Variant
ReDim lDenom(1 To n) As Long

Do While i < lSeats
    'identify max
    dMax = .Max(vB)
    k = .Match(dMax, vB, 0)
    lDenom(k) = lDenom(k) + 1
    vB(k, 1) = vA(k, 1) / (lDenom(k) + 1#)
    vR(k, 1) = vR(k, 1) + 1
    i = i + 1
Loop
sbdHondt = vR
End With
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

Logging (VBA Class)

Wed, 27 May 2026 13:20:00 +0100

“Testing can show the presence of bugs, but not their absence.” [Edsger W. Dijkstra]

Abstract

Diese clsLog Klasse bietet Logging mit den Berichtsstufen INFO, WARN, FATAL und EVER an. Die Programminformationen werden sowohl in einem Tabellenblatt als auch in einer Datei festgehalten.

Die Anwendung dieser clsLog Klasse ist nicht schwer: Einfach das allgemeine Modul modLog und das Klassenmodul *clsLog aus der unten bereitgestellten Beispieldatei in die eigene Anwendung kopieren, dann die Public Const AppVersion zum Beispiel mit dem Wert “Meine Anwendung Version 1.0” im Hauptmodul definieren, und dann kann man mit

Mythos Motivation

Wed, 27 May 2026 09:19:00 +0100

“Alles Motivieren ist Demotivieren.” [Reinhard K. Sprenger]

Abstract

Reinhard K. Sprenger schrieb ein lehrreiches Buch über das Motivieren von Mitarbeitenden. Seine zentrale Aussage: Lassen Sie es sein! Jeder besitzt eine intrinsische Motivation. Diese muss selbständig und individuell entwickelt werden, um zum Unternehmenserfolg beizutragen. Alle externen Motivierungsversuche werden scheitern.

Ich empfehle, sein Buch zu erwerben und zu lesen: (externer Link!) Mythos Motivation, Wege aus einer Sackgasse.

Die zentralen Aussagen aus Sprenger’s Buch

Das System der Motivierung ist methodisiertes Misstrauen.

TEXTVERKETTEN (VBA)

Wed, 27 May 2026 09:10:00 +0100

“The best way to pay for a lovely moment is to enjoy it.” [Richard Bach]

Abstract

Die Excel Funktion TEXTVERKETTEN kann ab Excel Version 2019 die Inhalte von Zellbereichen und Arrays als Zeichenketten verbinden und mit vorgegebenem Trennzeichen ausgeben. Für Excel Versionen älter als Excel 2019 können Sie die hier vorgestellte benutzerdefinierte Funktion TEXTVERKETTEN verwenden.

Das Gute ist: Wenn Sie dann auf Excel 2019 oder neuer umstellen, müssen Sie nichts machen. Excel wird dann automatisch die eingebaute Funktion TEXTVERKETTEN verwenden.

sbCellWatermarks (VBA)

Wed, 27 May 2026 08:47:00 +0100

Abstract

Falls Sie die Extremwerte einer Zelle nachverfolgen oder speichern müssen, hilft Ihnen der hier gezeigte VBA Code. Diese Lösung funktioniert für numerische Werte und Textwerte.

Appendix sbCellWatermarks Programmcode

Bitte den Haftungsausschluss im Impressum beachten.

Sub sbCellWatermarks(rCell As Range, rOutput As Range)
'Keep track of extreme values of a cell calculation.
'Call this sub from a worksheet's calculation event like
'Private Sub Worksheet_Change(ByVal Target As Range)
'    Call sbCellWatermarks(Range("watermark_cell"), _
'            Range("watermark_output"))
'End Sub
'If named range watermark_cell is set to B2 and watermark_output to
'B5:E6 a calculation example could be like:
'    Result  DateTime           Formula       Input Parameters
'Max    0    13/12/2008 12:41   =-((B1-3)^2)  3
'Min   -4    13/12/2008 12:46   =-((B1-3)^2)  5
'Source (EN): https://www.sulprobil.de/sbcellwatermarks_en/
'Source (DE): https://www.berndplumhoff.de/sbcellwatermarks_de/
'(C) (P) by Bernd Plumhoff 24-Jul-2011 PB V0.21

Dim i As Long, k As Long, p As Long, v As Variant

'Check input parameters thoroughly because we will switch off events
If Not TypeOf rCell Is Range Or Not TypeOf rOutput Is Range Then
    Call MsgBox("Input cell or output area are not of type RANGE!", _
            vbOKOnly, "Error")
    Exit Sub
End If
If rCell.Count <> 1 Then
    Call MsgBox("Input range should contain only 1 cell!", _
            vbOKOnly, "Error")
    Exit Sub
End If
If rCell.HasFormula Then p = rCell.DirectPrecedents.Count
If rOutput.Rows.Count < 2 Or rOutput.Columns.Count < 3 + p Then
    Call MsgBox("Output range should contain at least 2 rows and " & _
            3 + p & " columns!", vbOKOnly, "Error")
    Exit Sub
End If

Application.EnableEvents = False

k = Application.Calculation
Application.Calculation = xlCalculationManual
rCell.Calculate

If rCell.FormulaLocal <> rOutput(1, 3) Then
    'If formula changed reset statistics
    rOutput.ClearContents
    rOutput(1, 1) = rCell
    rOutput(2, 1) = rCell
    rOutput(1, 2) = Now
    rOutput(2, 2) = rOutput(1, 2)
    rOutput(1, 3) = "'" & rCell.FormulaLocal
    rOutput(2, 3) = "'" & rCell.FormulaLocal
    If rCell.HasFormula Then
        i = 4
        For Each v In rCell.DirectPrecedents
            rOutput(1, i) = v
            rOutput(2, i) = v
            i = i + 1
        Next v
    End If
ElseIf rCell > rOutput(1, 1) Then
    rOutput(1, 1) = rCell
    rOutput(1, 2) = Now
    If rCell.HasFormula Then
        i = 4
        For Each v In rCell.DirectPrecedents
            rOutput(1, i) = v
            i = i + 1
        Next v
    End If
ElseIf rCell < rOutput(2, 1) Then
    rOutput(2, 1) = rCell
    rOutput(2, 2) = Now
    If rCell.HasFormula Then
        i = 4
        For Each v In rCell.DirectPrecedents
            rOutput(2, i) = v
            i = i + 1
        Next v
    End If
End If

Application.Calculation = k
Application.EnableEvents = True

End Sub

Bitte den Haftungsausschluss im Impressum beachten.

sbTimeDiff (VBA)

Wed, 27 May 2026 02:17:00 +0100

“Patriotism is supporting your country all the time, and your government when it deserves it.” [Mark Twain]

Name

sbTimeDiff() - Berechne die Zeit zwischen zwei Zeitpunkten, aber zähle lediglich die spezifizierten Zeiten pro Wochentag oder Feiertag minus Pausen, falls die tägliche Arbeitszeit definierte Grenzwerte überschreitet.

Synopsis

sbTimeDiff(dtFrom, dtTo, vwh [, vHolidays] [, vBreaks])

Beschreibung

Berechnet die Zeit zwischen zwei Zeitpunkten, aber zähle lediglich die spezifizierten Zeiten pro Wochentag oder Feiertag minus Pausen, falls die tägliche Arbeitszeit definierte Grenzwerte überschreitet.

sbTimeAdd (VBA)

Wed, 27 May 2026 02:16:00 +0100

“Age is an issue of mind over matter. If you don’t mind, it doesn’t matter.” [Mark Twain]

Name

sbTimeAdd() - Addiere eine positive Zeit zu einem Datum mit Uhrzeit, wobei lediglich spezifizierte Zeitintervalle pro Wochentag und Feiertag berücksichtigt werden und auch eine definierte tägliche Pausenzeit abgezogen wird, falls die entsprechende tägliche definierte Arbeitszeit überschritten wird.

Synopsis

sbTimeAdd(dt, dh, vwh [, vHolidays] [, dtBreakLimit] [, dtBreakDuration])

Beschreibung

Addiere eine positive Zeit zu einem Datum mit Uhrzeit, wobei lediglich spezifizierte Zeitintervalle pro Wochentag und Feiertag berücksichtigt werden und auch eine definierte tägliche Pausenzeit abgezogen wird, falls die entsprechende tägliche definierte Arbeitszeit überschritten wird.

Value at Risk

Tue, 26 May 2026 17:42:00 +0100

“Even the youngest of us may be wrong sometimes.” [George Bernard Shaw]

Abstract

Value at Risk (VaR) ist das am häufigsten verwendete Maß für den Betrag, der aus einer Position oder einem Portfolio verloren gehen könnte.

VaR wird als der maximale Verlust verstanden, der bei einem gegebenen Konfidenzniveau über einen festgelegten Zeitraum auftreten könnte. Genauer gesagt, ist es der Schwellenwert, bei dem die Wahrscheinlichkeit, dass der Mark-to-Market-Verlust des Portfolios über diesen Zeitraum diesen Wert überschreitet, dem vorgegebenen Wahrscheinlichkeitsniveau entspricht. Wir gehen von normalen Märkten aus, und es findet kein Handel im Portfolio statt.

sbGetCell (VBA)

Mon, 25 May 2026 10:39:00 +0100

Abstract

In älteren Excel Versionen konnte man mit dem Excel4 Makro ZELLE.ZUORDNEN interessante Zellinformationen ausgeben. Zum Beispiel konnte man den Namen HatFormel mit dem Wert

=ZELLE.ZUORDNEN(48;INDIREKT("ZS(-1)";FALSCH))

im Namensmanager definieren. Wenn Sie dann =HatFormel in der Zelle rechts neben einer gewünschten Zelle eingegeben hätten, dann würde diese anzeigen ob die gewünschte Zelle eine Formel enthält (“WAHR”) oder nicht (“FALSCH”).

Sie können mit VBA ähnliche Informationen ausgeben lassen.

Parameter

Get.Cell Parameter	sbGetCell Parameter	Kommentar
1	AbsReference	Absolute Referenz der linken oberen Zelle im Bezug, als Text im aktuellen Arbeitsbereichs-Referenzstil
2	RowNumber	Zeilennummer der obersten Zelle im Bezug
3	ColumnNumber	Spaltennummer der linken Zelle im Bezug
4	Type	Entspricht TYP(Referenz): 1=Zahl, 2=Text, 4=Wahrheitswert, 16=Fehlerwert, 64=Matrix, 128=Verbunddaten
5	Contents	Inhalt der Referenz
6	FormulaLocal, ShowFormula	Formel in der Referenz als Text, entweder im A1- oder R1C1-Stil abhängig von der Arbeitsbereichseinstellung
7	NumberFormat	Zahlenformat der Zelle als Text (z. B. “TT.MM.JJJJ” oder “Standard”)
8	Horizontal alignment	Zahl zur Angabe der horizontalen Zellenausrichtung: 1=Allgemein, 2=Links, 3=Zentriert, 4=Rechts, 5=Füllen, 6=Blocksatz, 7=Zentriert über Auswahl
9	LeftBorderStyle	Zahl zur Angabe des linken Rahmenstils der Zelle: 0=Kein, 1=Dünn, 2=Mittel, 3=Gestrichelt, 4=Gepunktet, 5=Dick, 6=Doppelt, 7=Haarlinie, 8=Mittig gestrichelt, 9=Strich-Punkt, 10=Mittig Strich-Punkt, 11=Strich-Punkt-Punkt, 12=Mittig Strich-Punkt-Punkt, 13=Schräg Strich-Punkt
10	RightBorderStyle	Zahl zur Angabe des rechten Rahmenstils der Zelle: 0=Kein, 1=Dünn, 2=Mittel, 3=Gestrichelt, 4=Gepunktet, 5=Dick, 6=Doppelt, 7=Haarlinie, 8=Mittig gestrichelt, 9=Strich-Punkt, 10=Mittig Strich-Punkt, 11=Strich-Punkt-Punkt, 12=Mittig Strich-Punkt-Punkt, 13=Schräg Strich-Punkt
11	TopBorderStyle	Zahl zur Angabe des oberen Rahmenstils der Zelle: 0=Kein, 1=Dünn, 2=Mittel, 3=Gestrichelt, 4=Gepunktet, 5=Dick, 6=Doppelt, 7=Haarlinie, 8=Mittig gestrichelt, 9=Strich-Punkt, 10=Mittig Strich-Punkt, 11=Strich-Punkt-Punkt, 12=Mittig Strich-Punkt-Punkt, 13=Schräg Strich-Punkt
12	BottomBorderStyle	Zahl zur Angabe des unteren Rahmenstils der Zelle: 0=Kein, 1=Dünn, 2=Mittel, 3=Gestrichelt, 4=Gepunktet, 5=Dick, 6=Doppelt, 7=Haarlinie, 8=Mittig gestrichelt, 9=Strich-Punkt, 10=Mittig Strich-Punkt, 11=Strich-Punkt-Punkt, 12=Mittig Strich-Punkt-Punkt, 13=Schräg Strich-Punkt
13	Pattern	Zellmuster, 0-18
14	IsLocked	Gibt an, ob die Zelle gesperrt ist
15	HiddenFormula	Gibt an, ob die Formel ausgeblendet ist
16	CellWidth	Breite sowie Angabe, ob sie sich mit der Standardbreite ändert; zweielementiges horizontales Array
17	RowHeight	Zeilenhöhe
18	FontName	Schriftartname
19	FontSize	Schriftgröße
20	IsBold	Gibt an, ob der Text fett dargestellt ist
21	IsItalic	Gibt an, ob der Text kursiv dargestellt ist
22	IsUnderlined	Gibt an, ob der Text unterstrichen ist
23	IsStruckThrough	Gibt an, ob der Text durchgestrichen ist
24	FontColorIndex	Schriftfarbindex des ersten Zeichens, 1-56, 0 bei automatischer Farbe
25	IsOutlined	Nicht unterstützt von MS Excel
26	IsShaddowed	Nicht unterstützt von MS Excel
27	PageBreak	0 = kein Umbruch, 1 = Zeile, 2 = Spalte, 3 = Zeile und Spalte
28	RowLevelOutline	Gliederungsebene der Zeile
29	ColumnLevelOutline	Gliederungsebene der Spalte
30	IsSummaryRow	Gibt an, ob es sich um eine Summenzeile handelt
31	IsSummaryColumn	Gibt an, ob es sich um eine Summenspalte handelt
32	WorkbookSheetName	Name des Tabellenblatts im Format “[Book1]Sheet1” oder BOOK1.XLS, wenn das einzige Blatt denselben Namen wie die Arbeitsmappe hat
33	IsWrapped	Gibt an, ob der Textumbruch aktiviert ist
34	LeftBorderColorIndex	Farbindex des linken Rahmens
35	RightBorderColorIndex	Farbindex des rechten Rahmens
36	TopBorderColorIndex	Farbindex des oberen Rahmens
37	BottomBorderColorIndex	Farbindex des unteren Rahmens
38	ShadeForeGroundColor	Vordergrundfarbe der Schattierung
39	ShadeBackGroundColor	Hintergrundfarbe der Schattierung
40	TextStyle	Textstil
41	FormulaWOT	Formel ohne Übersetzung
46	HasNote	Enthält die Zelle eine Textnotiz?
47	HasSound	Nicht unterstützt. Soundnotizen wurden aus MS Excel entfernt
48	HasFormula	Gibt WAHR zurück, wenn die Zelle eine Formel enthält, andernfalls FALSCH bei Konstanten
49	IsArray	Gibt WAHR zurück, wenn die Zelle Teil eines Arrays ist, andernfalls FALSCH
50	VerticalAlignment	1 = Oben, 2 = Zentriert, 3 = Unten, 4 = Blocksatz, 5 = Verteilt
51	VerticalOrientation	0 = Horizontal, 1 = Vertikal, 2 = Aufwärts, 3 = Abwärts
52	IsStringConstant	Gibt ein Apostroph zurück, wenn die Eingabezelle eine Zeichenkettenkonstante ist
53	AsText	Inhalt der Zelle so, wie er aktuell angezeigt wird, als Text einschließlich zusätzlicher Zahlen oder Symbole durch die Zellformatierung
54	PivotTableViewName	Gibt den Namen der PivotTable-Ansicht zurück, die die aktive Zelle enthält
56	PivotTableViewFieldName	Gibt den Namen des Felds zurück, das die aktive Zellreferenz enthält, falls sie sich innerhalb einer PivotTable-Ansicht befindet
57	IsSuperscript	Gibt an, ob der Text hochgestellt ist
58	FontStyleText	Schriftstiltext aller Stile in der Zelle
59	UnderlineStyle	1 = keine, 2 = einfach, 3 = doppelt, 4 = einfache Buchhaltungsunterstreichung, 5 = doppelte Buchhaltungsunterstreichung
60	IsSubscript	Gibt an, ob der Text tiefgestellt ist
61	PivotTableItemName	Zu Demonstrationszwecken bezogen auf Zelle B86
62	WorksheetName	Arbeitsblattname wie [Arbeitsmappe1.xls]Tabelle1
65	IsAddIndentAlignment	Nicht unterstützt
66	WorkbookName	Name der Arbeitsmappe, die die Zelle enthält, im Format BOOK1.XLS
	IsHidden	Gibt an, ob die Zelle ausgeblendet ist

Appendix – Programmcode sbGetCell

Bitte den Haftungsausschluss im Impressum beachten.

Datumsformeln testen (Excel)

Mon, 25 May 2026 10:31:00 +0100

Abstract

Wie stelle ich sicher, dass eine Excel Datumsformel korrekt ist?

Ich teste sie!

So geht es am besten:

Ich generiere alle Tage des relevanten Datumsbereiches in Spalte A. Zum Beispiel 1-Jan-1901 bis 31-Dez-2099.
Ich gebe alle in Frage kommenden Formeln nebeneinander in die Spalten B und folgende ein und kopiere sie nach unten.
Ich vergleiche alle Ergebnisse mit der Referenzformel in Spalte B.

Beispiel

Wieviele ISO-Kalenderwochen berührt ein gegebener Monat?

sbEAN (VBA)

Mon, 25 May 2026 10:28:00 +0100

Abstract

Falls Sie eine Europäische Artikel Nummer (EAN) berechnen oder prüfen müssen:

Siehe auch

Zum Vergleich siehe (externer Link!) Prüfziffer berechnen und testen.

Appendix Programmcode sbEAN

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbEAN(s As String, _
  Optional bFullEAN As Boolean = True, _
  Optional bEAN14 As Boolean = False) As Variant
'Calculate or check EAN check digit. Works for EAN-8,
'EAN-13, EAN-14 / GTIN, and for EAN-18 / NVE / SSCC.
'If EAN is given without check digit, it is calculated
'and returned (full EAN if bFullEAn is True or just the
'check digit if False). If full EAN is entered the
'result of the check (True or False) will be returned.
'Source (EN): https://www.sulprobil.de/sbean_en/
'Source (DE): https://www.berndplumhoff.de/sbean_de/
'(C) (P) by Bernd Plumhoff 31-Mar-2024 PB V0.3
Dim i As Long, d As Long, m As Long, w As Long
Dim bCheck As Boolean
m = Len(s)
For i = 1 To m
  w = Asc(Mid(s, i, 1))
  If w < 48 Or w > 57 Then
    sbEAN = CVErr(xlErrNum)
    Exit Function
  End If
Next i
If bEAN14 Then
  If m = 13 Then
    bCheck = False
  ElseIf m = 14 Then
    bCheck = True
    m = m - 1 'Calculate checksum without check digit
  Else
    sbEAN = CVErr(xlErrValue)
    Exit Function
  End If
Else
  Select Case m
  Case 7, 12, 17
    bCheck = False
  Case 8, 13, 18
    bCheck = True
    m = m - 1 'Calculate checksum without check digit
  Case Else
    sbEAN = CVErr(xlErrValue)
    Exit Function
  End Select
End If
w = 3
For i = m To 1 Step -1
    d = d + Mid(s, i, 1) * w
    w = 4 - w 'Alternate between 3 and 1
Next i
d = (10 - d Mod 10) Mod 10
If bCheck Then
  sbEAN = Right(s, 1) = d
ElseIf bFullEAN Then
  sbEAN = s & d
Else
  sbEAN = d
End If
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbInWorten (VBA)

Mon, 25 May 2026 06:43:00 +0100

“Die Zahl regiert das Universum.” [Pythagoras]

Abstract

Manchmal müssen Sie Zahlen in Worten ausgeben, z. B. in Euro/Cent oder in Dollars/Cents oder in britischen Pfund Sterling/Pence. 12,31 würde zum Beispiel als “Zwölf Euro und Einunddreißig Cent” ausgegeben werden.

Hinweis: Im Web existiert eine Vielzahl von SpellNumber- und InWorten-Versionen. Leider sind die meisten davon fehlerhaft. Testen Sie am besten mit den hier genannten Beispielzahlen:

Appendix – Programmcode sbSpellNumber / sbInWorten

Bitte den Haftungsausschluss im Impressum beachten.

Optimale Ausnutzung von Ferientagen (VBA)

Mon, 25 May 2026 06:42:00 +0100

“I need a vacation.” [Arnold Schwarzenegger als T-800 in Terminator 2]

Abstract

Jedes Jahr stellt sich für die Berufstätigen unter uns die Frage, wann wir unseren Urlaub nehmen sollten.

Dieses Programm zeigt Ihnen, mit wieviel Urlaubstagen Sie welche Gesamtzahl an freien Tagen erreichen können:

Beispiel: Mit den angegebenen Feiertagen können Sie 2024 mit 7 Urlaubstagen 16 Tage vom 14. Dezember 2024 bis 29. Dezember 2024 frei nehmen. Mehr kann man mit 7 Tagen Urlaub 2024 nicht erreichen, wie die zweitbeste Lösung beweist (da sind es lediglich 14 freie Tage).

sbTasklist (VBA)

Mon, 25 May 2026 03:25:00 +0100

“Patience has its limits. Take it too far, and it is cowardice.” [George Jackson]

Abstract

Falls Ihr Team viele verschiedene manuelle Aufgaben erledigen muss, nicht alle täglich sondern auch an unterschiedlichen Wochentagen oder Arbeitstagen im Monat, dann könnte diese Aufgabenliste sie unterstützen.

Im Arbeitsblatt Param geben Sie Ihren Teamnamen oder eine andere Referenz ein, die im Fußbereich jeder Seite erscheinen soll, und auch den Arbeitstag:

Im Arbeitsblatt RawData definieren Sie welche Aufgaben täglich, wöchentlich, oder monatlich zu welchen Zeiten durchgeführt werden müssen. Sie müssen diese Aufgaben nicht nach der Uhrzeit sortieren, aber es könnte hilfreich sein:

RoundToSum (VBA)

Mon, 25 May 2026 03:14:00 +0100

“Every fool can know. The point is to understand.” [Albert Einstein]

Summenerhaltendes Runden

Gerundete Werte ergeben zusammen nicht immer ihre gerundete Summe. Wie stelle ich sicher, dass meine Aufstellung von gerundeten Prozentzahlen genau 100% ergibt? Kann ich für meine Buch¬haltung sicherstellen, dass meine Gemeinkostenverrechnung genau die originale Kostensumme verteilt? Diese Fragen sind seit langem bekannt und wurden oft analysiert.

In diesem Dokument wird eine einfach nutzbare Lösung mit Excel / VBA vorgestellt. Sie kann relative Werte (Prozentzahlen) auf 100% runden oder absolute Werte (z. B. Kostenrechnungsergebnisse) runden, ohne deren gerundete Summe zu verändern. Dabei kann je nach Parameter im Vergleich zur üblichen kaufmännischen Rundung der absolute Fehler oder der relative Fehler minimal gehalten werden.

sbZip (VBA)

Sun, 24 May 2026 08:04:00 +0100

Abstract

Mit VBA kann man leicht einen Ordner oder eine Datei im Zip-Format komprimieren.

Diese Variante ist meine bevorzugte:

Appendix – sbZip Code

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

#Const SBZIP_LOG = True 'Use sbZip with logging (True) or not (False)

Sub sbZip(ByVal vSourceFullPathName As Variant, _
          ByVal vDestinationZipFullPathName As Variant, _
          Optional bCreate As Boolean = True, _
          Optional bUse7zip As Boolean = False)
'Create zip file vDestinationZipFullPathName and insert zipped file or folder vSourceFullPathName.
'This sub is using LibFileTools, https://github.com/cristianbuse/VBA-FileTools.
'If bUse7zip:=True then 7zip needs to be installed at C:\Program Files\7-Zip\7z.exe.
'Version When        Who   What
'     14 08-May-2025 Bernd Overwrite zip constituent (by moving it to Temp)
'                          without warning message that it already exists
'     15 25-Dec-2025 Bernd Use #If SBZIP_LOG
Dim iFile     As Integer
Dim lItems    As Long
Dim lRepeat   As Long
Dim sBasename As String
Dim sLine     As String
Dim sShellCmd As String
Dim sPath     As String
Dim v         As Variant
Dim oExec     As Object
Dim oOutput   As Object
Dim oShell    As Object
#If SBZIP_LOG Then
Dim GLogger   As clsLog
#End If
#If MEASURE_RUNTIME Then
Dim cPerf     As clsPerf 'See: https://jkp-ads.com/Articles/performanceclass.asp

Set cPerf = New clsPerf
cPerf.SetRoutine "sbZip"
#End If
#If SBZIP_LOG Then
Set GLogger = New clsLog
g_log_params.log_sub_name = "sbZip"
GLogger.info "Started with vSourceFullPathName = '" & vSourceFullPathName & _
          "', vDestinationZipFullPathName = '" & vDestinationZipFullPathName & _
          "', bCreate = " & bCreate & _
          "', bUse7zip = " & bUse7zip
#End If
If bCreate Then
  If IsFile(CStr(vDestinationZipFullPathName)) Then
    If Not DeleteFile(CStr(vDestinationZipFullPathName)) Then
#If SBZIP_LOG Then
      GLogger.warn "Could not delete file '" & vDestinationZipFullPathName & "'"
#End If
    End If
  End If
End If
If bUse7zip Then
  If IsFile("C:\Program Files\7-Zip\7z.exe") Then
    Set oShell = CreateObject("WScript.Shell")
    sShellCmd = "C:\Program Files\7-Zip\7z.exe a """ & vDestinationZipFullPathName & _
      """ """ & vSourceFullPathName & """"
    Set oExec = oShell.exec(sShellCmd)
    Set oOutput = oExec.StdOut
    Do While Not oOutput.AtEndOfStream
      sLine = oOutput.ReadLine
#If SBZIP_LOG Then
      If sLine <> "" Then GLogger.info "STDOUT " & sLine
#End If
    Loop
    Set oOutput = oExec.StdErr
    Do While Not oOutput.AtEndOfStream
      sLine = oOutput.ReadLine
#If SBZIP_LOG Then
      If sLine <> "" Then GLogger.warn "STDERR " & sLine
#End If
    Loop
    Do While oExec.Status = 0
      Application.Wait (Now + TimeValue("0:00:01"))
    Loop
#If SBZIP_LOG Then
    GLogger.info vSourceFullPathName & "' zipped into '" & vDestinationZipFullPathName & "'"
#End If
  Else
#If SBZIP_LOG Then
    GLogger.fatal "C:\Program Files\7-Zip\7z.exe doesn't exist. Cannot zip '" & _
    vSourceFullPathName & "'"
#End If
  End If
Else
  If bCreate Then
    sPath = GetLocalPath(ThisWorkbook.Path)
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    If IsFile(sPath & "Zip_Template.zip") Then
      'Workaround in case print sequence in Else clause does not work
      CopyFile sPath & "Zip_Template.zip", CStr(vDestinationZipFullPathName)
      If Not IsFile(CStr(vDestinationZipFullPathName)) Then
#If SBZIP_LOG Then
        GLogger.warn "Could not copy template file '" & vDestinationZipFullPathName & "'"
#End If
      End If
    Else
      iFile = FreeFile
      Open vDestinationZipFullPathName For Output As #iFile
      Print #iFile, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
      Close #iFile
    End If
  End If
 
  Set oShell = CreateObject("Shell.Application")
  On Error Resume Next
  lItems = oShell.Namespace(vDestinationZipFullPathName).Items.Count
  On Error GoTo 0
  If GetAttr(vSourceFullPathName) = vbDirectory Then
    oShell.Namespace(vDestinationZipFullPathName).CopyHere _
    oShell.Namespace(vSourceFullPathName).Items, 16
    lRepeat = 0
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = _
      lItems + oShell.Namespace(vSourceFullPathName).Items.Count Or lRepeat > 5
      Application.Wait (Now + TimeValue("0:00:01"))
      lRepeat = lRepeat + 1
    Loop
    On Error GoTo 0
  Else
    If lItems > 0 Then
      sBasename = Right(vSourceFullPathName, InStr(StrReverse(vSourceFullPathName), "\") - 1)
      For Each v In oShell.Namespace(vDestinationZipFullPathName).Items
        If v.Name = sBasename Then
          oShell.Namespace(Environ("Temp")).MoveHere (v)
          DeleteFile Environ("Temp") & "\" & sBasename
          Exit For
        End If
      Next v
    End If
    oShell.Namespace(vDestinationZipFullPathName).CopyHere vSourceFullPathName, 16
    lRepeat = 0
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = _
      lItems + 1 Or lRepeat > 3
      Application.Wait (Now + TimeValue("0:00:01"))
      lRepeat = lRepeat + 1
    Loop
    On Error GoTo 0
  End If
End If
#If SBZIP_LOG Then
GLogger.info "Beendet ohne Fehler"
#End If
End Sub

Download

Bitte den Haftungsausschluss im Impressum beachten.

Krabat (Excel)

Sun, 24 May 2026 04:06:00 +0100

Abstract

(Externer link!) Krabat ist ein Jugendbuch von Otfried Preußler.

Ich fand die Geschichte faszinierend, aber etwas unlogisch: 12 Lehrlinge arbeiten in der Mühle. Jedes Jahr stirbt einer, und jedes Jahr wird ein neuer Lehrling im Alter von 14 Jahren aufgenommen. Alle altern innerhalb eines Jahres um drei Jahre.

Nach 30 Jahren kann es einen Lehrling geben, der 101 Jahre alt ist:

Download

Bitte den Haftungsausschluss im Impressum beachten.

Krabat.xlsx [16 KB Excel Datei, ohne jegliche Gewährleistung]

sbNRN (VBA)

Sun, 24 May 2026 03:26:00 +0100

“Die ganzen Zahlen hat der liebe Gott gemacht, alles andere ist Menschenwerk.” [Leopold Kronecker]

Abstract

Welche rationale Zahl ist eine gute Näherung von π (3,1415926…)? Geben Sie ein: in Zelle A1 ‘=pi()’, in Zelle B1 den maximal gewünschten Nenner (zum Beispiel 10), und als Matrixformel (mit STRG + SHIFT + ENTER) in den Zellen C1:D1 ‘=sbNRN(A1;B1)’. Als Ergebnis erscheint in C1:D1 22 und 7. Dies bedeutet: 22/7 ist die nächstliegende rationale Zahl (Bruch) zu π mit einem Nenner nicht größer als 10. Mit 1000 in B1 würde man 355/113 erhalten.

Exakte Rechnung mit Rationalen Zahlen

Sun, 24 May 2026 03:17:00 +0100

Abstract

Vorgestellt wird die Möglichkeit der genauen Rechnung mit rationalen Zahlen. Die Vorteile einer Rationalzahlarithmetik gegenüber einer Festpunkt- oder Gleitpunktarithmetik:

Die Möglichkeit der genauen Darstellung aller “einfachen” Brüche (wie 1/3, 3/7 usw.).
Die Möglichkeit der Berechnung genauer Zwischenergebnisse bei den Grundrechenarten (einschließlich der Division!).
Die Existenz des genauen multiplikativen Inversen aller Elemente (außer 0) im darzustellenden Bereich.
Bei festem Bruchstrich (engl. fixed slash) Unabhängigkeit von der Zahlenbasis.

Rationalzahlen in Rechenanlagen

Fixed Slash

Für Zähler und Nenner stehen jeweils die gleiche Anzahl von Stellen zur Verfügung:

Excel VBA Eine Sammlung (Excel / VBA)

Sat, 23 May 2026 07:12:00 +0100

“Excel-Tabellen gehören wahrscheinlich zu den gefährlichsten Erfindungen der letzten Jahrzehnte.” [Rolf Dobelli]

Excel VBA Eine Sammlung

Dies ist eine Sammlung von Excel VBA Programmen und auch einigen Excelformeln, die mir sinnvoll erschienen.

Hinweis: Ich habe die hier vorgestellten Programme und Formeln erfolgreich mit Excel 2024 / 365 getestet.

Inhaltsverzeichnis                                                                   
                                                                                     
Excel / VBA – Eine Sammlung                                                          1
  Abstract                                                                           2
  Excel Lernpfad                                                                     2
Die Excel / VBA Programmierumgebung                                                 11
  Abstract                                                                          11
  Grundlegendes                                                                     11
    Variablen                                                                       11
      Variablentypen                                                                11
      Scope                                                                         12
    Während des Editierens                                                          12
    Während der Programmausführung                                                  13
      Breakpoints                                                                   13
      Fehlerbehandlung                                                              14
    Umgebungsvariablen                                                              15
    Gute Programmierpraxis                                                          15
      Seien Sie ein guter Programmierer                                             15
      Gutes Excel und VBA Wissen                                                    15
      Programmierkonventionen                                                       16
      Säubern Sie Makroaufzeichnungen                                               16
      Dokumentieren Sie Ihr Programm ausreichend                                    16
      Testen Sie Ihr Programm gut                                                   16
      Protokollieren Sie Ihre Programmausführung                                    16
  Laufzeit Optimieren                                                               17
    Module                                                                          17
      Normal                                                                        17
      Klassenmodule                                                                 19
  Systemstatus sichern und zurückschreiben – SystemState Klasse                     20
    Systemstatus Variablen                                                          20
  Programmablauf dokumentieren – clsLog Klasse                                      23
    Für und Wider                                                                   23
    Parameter                                                                       24
    Beispielausgabe                                                                 25
    Module                                                                          26
      Normal                                                                        26
      Klassenmodule                                                                 31
  Start / Stop OneDrive Synchronisierung                                            33
  Exportiere einen Bereich als Grafik – sbExportRange2Picture                       35
  Bereichsnamen anzeigen – sbNamedRanges                                            38
  Anzahl der Dimensionen eines Arrays – ArrayDim                                    38
  Excel Version anzeigen – ApplicationVersion                                       39
  Zellinformationen ausgeben – sbGetCell                                            40
  Nächste Gleitkommazahl – sbNextFloat                                              46
  Aufruf anderer Windows Programme am Beispiel sbZip                                47
  Excel Don’ts – Was man mit Excel besser sein lässt                                49
    Eine Tabelle mit Beispielen die man besser vermeidet                            49
Zahlensysteme, Formate und Umwandlungen                                             50
  Abstract                                                                          50
  Umwandlungen und Berechnungen von Zahlen                                          50
    Zahlen in Worten ausgeben – sbInWorten                                          50
    Umwandlungen zwischen dem Dezimalsystem und dem Binärsystem                     54
    Feiertage ermitteln – IstFeiertag                                               59
    Zahl vollständig nicht-wissenschaftlich darstellen – sbNum2Str                  63
    Signifikante Ziffern einer Zahl – sbNSig                                        64
    Nummer eines Monatsnamens – sbMonatsZahl                                        65
    Die Berechnung der Kreiszahl π                                                  68
      Pi Ausgabe auf 1000 Stellen                                                   71
    Die Berechnung der Eulerschen Zahl e                                            72
      e Ausgabe auf 1000 Stellen                                                    73
    Literatur                                                                       74
    Zahlenfolge kürzer darstellen – sbParseNumSeq                                   74
  Rationale Zahlen = Brüche                                                         76
    Ermittle die nächstliegende rationale Zahl zu einer Gleitkommazahl – sbNRN      76
    Lineare Gleichungssysteme mit rationalen Koeffizienten                          79
    Anteilsveränderung als Bruch                                                    82
    Monatsanteil                                                                    83
  Linearkombination Ganzer Zahlen                                                   84
    Erweiterter Euklidischer Algorithmus – sbEuklid                                 84
  Uhrzeiten                                                                         86
    Arbeitszeit zwischen 2 Zeitpunkten – sbTimeDiff                                 86
    Arbeitszeit zu einem Zeitpunkt addieren – sbTimeAdd                             89
    Uhrzeit für eine andere Zeitzone umwandeln – ConvertTime                        92
  Prüfziffern                                                                       92
    Berechne oder prüfe eine Europäische Artikelnummer – sbEAN                      92
  Ordinalzahlen (englisch)                                                          93
Einfache Mathematik in Formeln                                                      94
  Wie man Tabellenblattformeln analysiert                                           94
  Datumsformeln testen                                                              95
  Erster oder letzter Wochentag im Monat                                            97
  Derselbe Wochentag und Kalenderwoche im vorigen Jahr                              98
  Budgetkontrolle                                                                   99
  Geringste Signifikante Ziffer erhöhen                                            100
  Linearer Breakdown                                                               101
  Füge zwei Spalten mit Blocksatz zusammen                                         104
  Minimum Truck Load Problem                                                       105
  Nachstehende Nullen zählen                                                       106
  Minimax Interpolation                                                            106
  Interpolation mit PERZENTIL / PROZENTRANG                                        108
  Interpolation mit TREND                                                          110
  REFA Zeitklassen                                                                 111
  Rollen und Rechte                                                                112
  Rundungstricks                                                                   113
  Trinkgeld Verteilung                                                             114
  Unterjährige Werte glätten                                                       116
  Zellenbasiertes Diagramm                                                         117
Einfache VBA Programme                                                             119
  Abstract                                                                         119
  Addiere Zahlen desselben Zahlenformats – sbSumMyFormat                           119
  Zähle Zellen mit einer bestimmten Farbe – sbCountMyColor                         120
  Asset Allokation für ein Portfolio – sbAllocate                                  121
  Ausreißer Werte eliminieren – sbORB                                              122
  Faire Verteilung eines begrenzten Budgets – sbDistBudget                         124
  Collatz Länge Berechnen - sbCollatz                                              126
  Eindeutigen Rang auch bei Duplikaten vergeben – sbUniqRank                       127
  Eliminiere Punkte eines Graphen mit kleiner Steigungsänderung – sbReducePoints   129
  Geburtstagsliste – sbBirthdayList                                                131
  Akumuliertes Handelsblatt – sbAccumulatedTradeBlotter                            133
  Häufigste Paare – sbMostFrequentPairs                                            135
  Interpolieren – sbInterp                                                         137
  Erzeuge alle Kombinationen der Subsets k von n                                   139
  Lookup Varianten                                                                 141
  Minimale Anzahl von Scheinen und Münzen für einen Geldbetrag – sbMinCash         144
  Neugewichtung der Assets eines Portfolios – sbRebalancedReturn                   147
  Optimale Boxenstopps                                                             149
  Optimale Nutzung von Urlaubstageen                                               151
  Rundensystem für Turnier Jeder Gegen Jeden - sbRoundRobin                        153
  Zugriffsrechte prüfen                                                            156
VBA Programme für Fortgeschrittene                                                 159
  Abstract                                                                         159
  Mitarbeiter Umsatzanteile                                                        159
  Extremwerte von Zellen speichern – sbCellWatermarks                              165
  Aufgabenliste – sbTaskList                                                       167
  Zahlungseingangsproblem                                                          170
  Datenanalyse – sbDatastats                                                       173
    System Handbuch                                                                173
      Übersicht                                                                    173
      Parameter im Tabellenblatt Param                                             174
    Anwenderhandbuch                                                               175
      Zusammenfassung                                                              175
      Konfigurationsdatei FileSpecs.csv                                            175
      NumStats Ausgabe                                                             176
      NumStatsMove Ausgabe                                                         176
      TextStats Ausgabe                                                            176
      TextStatsMove Ausgabe                                                        176
      Limits_Output Datei                                                          177
      Limits_Move_Output Datei                                                     178
  Lotto k-Tupel                                                                    208
  Minirechner                                                                      211
  Sterblichkeitsrente                                                              218
    Komplexe Matrixformel (Schlechteste Wahl)                                      218
    Einfache Benutzerdefinierte Funktion mit VBA (Bessere Wahl)                    219
    Vorkalkulierte Tabelle und eine NBW Formel (Wahrscheinlich am Besten)          219
  Finanzmathematik – Optionen                                                      220
    Das Binomialbaummodell                                                         220
    Das Trinomial-Optionspreismodell und die Methode der Finiten Differenzen       226
    Monte Carlo Simulation                                                         232
  Erzeuge alle Permutationen eines Arrays – Quickperm                              242
  Eine wartungsfreie Datenbenk                                                     244
    Einschränkungen                                                                244
    Verantwortlichkeiten                                                           244
    Systemdokumentation                                                            245
    Anwenderdokumentation                                                          245
      Super User mit Schreib-/Lesezugriff                                          245
      Normaler Anwender nur mit Lesezugriff                                        245
    Appendix – SQL Code                                                            246
    Appendix – VBA Code                                                            249
Summenerhaltendes Runden mit RoundToSum                                            252
  Abstract                                                                         252
  Summenerhaltendes Runden                                                         252
    Beispiel für Prozentzahlen                                                     252
    Beispiel für absolute Zahlen                                                   253
  Die benutzerdefinierte VBA Funktion RoundToSum                                   253
  RoundToSum Programmcode                                                          254
  Round2Sum Lambda-Ausdruck                                                        255
  Werte runden ändert ihre Summe                                                   256
  Wieviele Summanden müssen im Mittel 'falsch' gerundet werden?                    258
  Anwendungsbeispiele für RoundToSum                                               260
    Gemeinkostenumlage                                                             260
    Beispiel für ein exaktes Verhältnis von Zufallszahlen                          262
      Die benutzerdefinierte VBA Funktion sbExactRandHistogrm                      263
    Faire Mitarbeiterauswahl nach Teamgröße – sbFairStaffSelection                 265
    Stichprobe normalverteilen                                                     267
    Verteilung nach Restmenge                                                      272
      Ein simpler Ansatz                                                           272
      Eine korrekte Rechnung                                                       272
    Urlaub nehmen wenn weniger los ist                                             273
      Simples Beispiel                                                             273
      Komplexeres Beispiel                                                         274
    Zuweisen von Arbeitseinheiten vermindert um geleistete                         275
  RoundToSum im Vergleich                                                          276
    RoundToSum im Vergleich mit anderen “einfachen” Methoden                       276
    RoundToSum im Vergleich zum D‘Hondt Verfahren                                  279
  Literatur                                                                        279
Zufallszahlen erzeugen                                                             280
  Abstract                                                                         280
  Ganze Zufallszahlen                                                              280
    Natürliche Zufallszahlen – UniqRandInt                                         280
    Ganze Zufallszahlen – sbRandInt                                                282
    Zufallszahlen mit einer festgelegten Summe                                     284
      Minimum für die Zufallszahlen vorgegeben - sbLongRandSumN                    284
      Minimum und Maximum für die Zufallszahlen vorgegeben - sbRandIntFixSum       285
  Praktische Anwendungen ganzer Zufallszahlen                                      287
    Krabat – Wie alt können die Lehrlinge werden?                                  287
    Ein Mathematiktest mit ganzen Zufallszahlen – Generate_Math_Test               288
    Monte Carlo Simulation für eine faire Teamverteilung – sbGenerateTeams         290
    Monte Carlo Simulation für einen Regatta Flight Plan – sbRegattaFlightPlan     294
    Chancen beim Brettspiel Risiko                                                 297
    Eine simple Monte Carlo Simulation                                             301
  Gleitkomma-Zufallszahlen                                                         303
    Eine ideale Normalverteilung – sbGenNormDist                                   303
    Zufallszahlen mit der Summe 1 – sbRandSum1                                     305
    Verteilungen von Gleitkomma-Zufallszahlen                                      307
      sbRandGeneral                                                                307
      sbRandHistogrm                                                               310
      sbRandTriang                                                                 313
      sbRandTrigen                                                                 314
      sbRandCauchy                                                                 318
      sbRandCDFInv                                                                 319
      sbRandPDF                                                                    320
      sbRandCumulative                                                             321
    Brownsche Brücken                                                              323
      sbGrowthSeries                                                               323
      Fixe Summe aus verschiedenen Zufallsbereichen                                325
  Korrelierte Zufallszahlen                                                        327
    Cholesky Zerlegung                                                             327
    Iman-Conover Methode                                                           329
  Praktische Anwendungen allgemeiner Zufallszahlen                                 336
    Testdaten erzeugen – sbGenerateTestData                                        336
    Zufallszahlen die sich nicht sofort wiederholen – sbRandomNoRepeatBeforeN      346
  Exkurs                                                                           348
    Wahrscheinlichkeiten berechnen – Ziehen von Karten mit und ohne Zurücklegen    348
Spaß ohne Praxisrelevanz für Fortgeschrittene                                      349
  Eine einfache VBA Pivot Tabelle – sbMiniPivot                                    349
  Rundenturnier-Paarungen mit Excel Tabellenblattfunktionen                        352
    Entwickeln einer Formellösung für ein Rundenturnier Jeder gegen Jeden          352
  TEXTVERKETTEN                                                                    356
Index                                                                              357

Bitte den Haftungsausschluss im Impressum beachten.

sbCollatz (VBA)

Sat, 23 May 2026 06:57:00 +0100

“Mathematics is not yet ready for such problems.” [Paul Erdös]

Abstract

Die Collatz Vermutung für naturliche Zahlen:

Eine gerade Zahl wird halbiert
Eine ungerade Zahl wird verdreifacht und um 1 erhöht

Wenn Sie die oben genannten Regeln wiederholt anwenden, gelangen Sie stets zur Zahl 1.

Beispiel

Wenn Sie mit 5 beginnen, erhalten Sie die Folge 5, 16, 8, 4, 2, 1, die eine Collatz Länge von 6 besitzt.

Appendix – sbCollatz Programmcode

Bitte den Haftungsausschluss im Impressum beachten.

sbDec2Bin (VBA)

Sat, 23 May 2026 06:56:00 +0100

Abstract

Wie lautet die binäre Darstellung (Bitlänge = 256) der Dezimalzahl -872362346234627834628734627834627834628? Die eingebaute Excel Funktion DEZINBIN hilft hier nicht weiter. Sie kann nur Eingaben von -512 bis 511 verarbeiten. Wenn Sie die korrekte Antwort

1111111111111111111111111111111111111111111111111111111111111111111111111111
1111111111111111111111111111111111111111111111111101011011111011010100011111
1001110111100101111001000010000111010110010010100110011010001001100111101010
0001010101001011110011111100

erhalten wollen, benutzen Sie bitte die unten gezeigte Funktion sbDec2Bin.

Bitte bachten: Nachkommastellen werden lediglich für positive Zahlen unterstützt. Zum Beispiel lautet die Dezimalzahl 0.5 im Binärformat 0.1.

Hinweis: sbDec2Bin wird auf der Seite Schule des Denkens als Beispiel vorgestellt.

Erweiterter Euklidischer Algorithmus (VBA)

Sat, 23 May 2026 06:55:00 +0100

Abstract

Sie wollen eine Zahl als nicht-negative Linearkombination zweier natürlicher Zahlen darstellen?

Dies kann man mit dem (externer Link!) erweiterten Euklidischen Algorithmus erreichen:

Hinweis: Wenn das Wunschergebnis ein Vielfaches des größten gemeinsamen Teilers der eingegebenen Zahlen ist, dann existiert immer eine ganzzahlige Lösung, aber nicht notwendigerweise eine nicht-negative. Beispiel: Sie können mit den Eingaben 5 und 3 das Wunschergebnis 1 ganzzahlig darstellen, weil 1 der GGT von 5 und 3 ist: 1 = 2 * 5 + (-3) * 3. Aber es geht nicht mit ausschließlich nicht-negativen Faktoren.

sbMinCash (VBA)

Fri, 22 May 2026 05:49:00 +0100

Abstract

Wenn Sie die kleinste Menge an Geldscheinen und Münzen ermitteln wollen, um auf einen Betrag zu kommen, hilft dieses Programm:

Mögliche Fehlerwerte sind:

#ZAHL! - Der Eingangsbetrag oder der Wert eines Scheins oder Münze hat mehr als 2 Nachkommastellen
#WERT! - Der Wert eines Scheins oder einer Münze ist negativ oder ungültig
#NV - Es existiert keine Lösung

Eine bekannte Ausnahme: Falls die Werte der Scheine oder Münzen ungünstig sind, dann ist die ausgegebene Stückelung nicht minimal. Beispiel: Mit den Münzwerten 1, 6, und 10 wird der Eingabebetrag 13 mit der Stückelung 10, 1, 1, 1 und nicht 6, 6, 1 ausgegeben. Die gute Nachricht ist jedoch: Dies tritt nicht im normalen Fall mit Werten wie 1000, 500, 200, 100, 50, 20, 10, 5, 2, 1, 0.50, 0.20, 0.10, 0.05, 0.02, und 0.01 auf.

sbInterp (VBA)

Thu, 21 May 2026 01:52:00 +0100

“Write what you know. That should leave you with a lot of free time.” [Howard Nemerov]

Abstract

Falls Sie eine Menge von bekannten (x, y) Paaren haben und y-Werte zu anderen gegebenen x-Werten finden müssen, müssen Sie interpolieren. Dies entspricht dem Füllen von Lücken in einer Tabelle:

Appendix – Programmcode sbInterp

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit
    
Function sbInterp(vX As Variant, vY As Variant, _
           vT As Variant, _
           Optional ByVal sType As String = "Linear", _
           Optional bExtrapolate As Boolean = True, _
           Optional ByVal sExtraType As String) As Variant
'Interpolates y-values for target values vT with known
'y-values vY and known x-values vX with type sType.
'sType can be:
'Const or C
'Linear or L
'LinearInVariance or LIV
'Extrapolation will be done if bExtrapolate is TRUE.
'Extrapolation type sExtraType defaults to sType if empty.
'Values in vX must be in ascending order. #VALUE! error
'indicates illegal sType, #NUM! error indicates that
'extrapolation has been switched off and #N/A tells you
'that x-values are not given in increasing order, or
'y-value count differs from x-value count.
'Source (EN): https://www.sulprobil.de/sbinterp_en/
'Source (DE): https://www.berndplumhoff.de/sbinterp_de/
'(C) (P) by Bernd Plumhoff 25-Dec-2023 PB V0.7
Dim i As Long, iX As Long, iY As Long, iT As Long, k As Long
Dim vTk, vXi
Dim sT As String 'Type of inter- or extrapolation
Dim sEType As String 'Extrapolation type
With Application
On Error Resume Next
iX = vX.Count
iX = UBound(vX)
iY = vY.Count
iY = UBound(vY)
iT = vT.Count
iT = UBound(vT)
On Error GoTo 0
If iX <> iY Then
    sbInterp = CVErr(xlErrNA)
    Exit Function
End If
k = 0
ReDim vX1(1 To iX) As Variant, vY1(1 To iX) As Variant
For i = 1 To iX
    If vX(i) <> "" And vY(i) <> "" Then
        k = k + 1
        vX1(k) = vX(i)
        vY1(k) = vY(i)
    End If
Next i
iX = k
ReDim Preserve vX1(1 To iX) As Variant
ReDim Preserve vY1(1 To iX) As Variant
If iX < 2 Then
    sType = "Const"
    sExtraType = "Const"
Else
    For k = 2 To iX
        If vX1(k) <= vX1(k - 1) Then
            sbInterp = CVErr(xlErrNA)
            Exit Function
        End If
    Next k
End If
ReDim vR(1 To iT) As Variant
If sExtraType = "" Then
    sEType = sType 'Same as interpolation type
Else
    sEType = sExtraType
End If
For k = 1 To iT
    i = 0
    vTk = 0
    vXi = 0
    On Error Resume Next
    i = .Match(vT(k), vX1, 1)
    vTk = vT(k)
    vXi = vX1(i)
    On Error GoTo 0
    If Not bExtrapolate And _
        (i = 0 Or (i = iX And vTk <> vXi)) Then
        vR(k) = CVErr(xlErrNum)
    Else
        sT = sType 'Set to interpolation type
        If i = 0 Then
            i = 1
            sT = sEType 'Set to extrapolation type
        End If
        If i = iX Then
            i = i - 1
            If vTk <> vXi Then
                sT = sEType 'Set to extrapolation type
            End If
            If sT = "C" Or sT = "Const" Then i = i + 1
        End If
        Select Case sT
        Case "C", "Const"
            vR(k) = .Index(vY1, i)
        Case "L", "Linear"
            vR(k) = .Index(vY1, i) + (vTk - .Index(vX1, i)) _
                * (.Index(vY1, i + 1) - .Index(vY1, i)) _
                / (.Index(vX1, i + 1) - .Index(vX1, i))
        Case "LIV", "LinearInVariance"
            On Error Resume Next
            vR(k) = Sqr(.Index(vY1, i) ^ 2# + (vTk - .Index(vX1, i)) _
                * (.Index(vY1, i + 1) ^ 2# - .Index(vY1, i) ^ 2#) _
                / (.Index(vX1, i + 1) - .Index(vX1, i)))
            On Error GoTo 0
        Case Else
            sbInterp = CVErr(xlErrValue)
            Exit Function
        End Select
    End If
Next k
If TypeName(vT) = "Range" Then
    If vT.Rows.Count > vT.Columns.Count Then
        vR = .Transpose(vR)
    End If
ElseIf TypeName(.Caller) = "Range" Then
    If .Caller.Rows.Count > .Caller.Columns.Count Then
        vR = .Transpose(vR)
    End If
End If
sbInterp = vR
End With
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

Optionen (VBA)

Wed, 20 May 2026 04:38:00 +0100

Abstract

Ein klassisches Buch zur Bewertung von Optionen ist

Les Clewlow and Chris Strickland: Implementing Derivatives Models (ISBN 0471966517)

Leider enthält dieses Buch eine Vielzahl von Fehlern, und die 8 Seiten lange Fehlerliste vom 23. November 2000 scheint auch nicht mehr öffentlich verfügbar zu sein.

Einige Fehlerkorrekturen für die erste Auflage:

Page	Row	Correction
xvi	9, column 3	0v should be C
12	15	Si,j = Su^jd^(n-j)
24	2 from top in figure 2.12	set coefficients
70	4 from bottom in figure 3.13	for j =Nj-2 downto -Nj+1 do
70	Insert before last row of figure 3.13	C[1,-Nj] = C[1,-Nj + 1] - lambda_L
75	4 from bottom in figure 3.16	for j =Nj-2 downto -Nj+1 do
75	Insert before last row of figure 3.16	C[1,-Nj] = C[1,-Nj + 1] - lambda_L
85	2 from bottom in figure 4.2	SD = sqrt( (-sum_CT2 + sum_CT * sum_CT / M ) ) * exp(-2rT) / (M - 1)
89	2 from bottom in figure 4.5	SD = sqrt( (-sum_CT2 + sum_CT * sum_CT / M ) ) * exp(-2rT) / (M - 1)
99	Delete row 9 from top	lnS = ln(S) = 4.6052 <- delete this row
113	13 from top in figure 4.19	Insert before for j loop V1 = sig1sig1; V2 = sig2sig2
113	18 from top in figure 4.19	Insert before for i loop Vt1 = V1; Vt2 = V2
118	Last row	a = m/N * ln(Gt) …
120	11 from bottom in figure 4.24	G = productSt ^(1/N)

Ich implementierte einige der im Buch vorgestellten Algorithmen mit Excel VBA.

Sterblichkeitsrente (Excel, VBA)

Wed, 20 May 2026 04:37:00 +0100

Abstract

Sie haben viele verschiedene Möglichkeiten, eine Sterblichkeitsrente zu berechnen:

Komplexe Matrixformel (Schlechteste Wahl)

Wenden Sie eine recht komplexe Matrixformel an:

Die Namen sind wie folgt definiert:

Einfache Benutzerdefinierte Funktion mit VBA (Bessere Wahl)

Ein weitaus besser Weg besteht in einer einfachen benutzerdefinierten Funktion:

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit
    
Function LiveAnnuityPV(lYears As Long, dInterestRate As Double, _
    rMortalityTable As Range) As Double
'Source (EN): https://www.sulprobil.de/mortality_annuities_en/
'Source (DE): https://www.berndplumhoff.de/mortality_annuities_de/
'(C) (P) by Bernd Plumhoff 22-Mar-2014 PB V0.1
Dim j As Long
Dim dSum As Double, dProd As Double, dPV As Double

dProd = 1#
dPV = 1#
For j = 1 To rMortalityTable.Count - lYears
    dPV = dPV / (1# + dInterestRate)
    dProd = dProd * (1# - rMortalityTable(j + lYears))
    dSum = dSum + dPV * dProd
Next j

LiveAnnuityPV = dSum

End Function

Vorkalkulierte Tabelle und eine NBW Formel (Wahrscheinlich am Besten)

Der schnellste und wahrscheinlich beste Ansatz besteht aus einer vorkalkulierten Tabelle und einer NBW Formel:

QuickPerm (Excel / VBA)

Wed, 20 May 2026 04:36:00 +0100

Abstract

Wenn Sie alle Permutationen eines Arrays erzeugen wollen, empfehle ich den Algorithmus (externer Link!) Quickperm. Es ist einer der effizientesten Permutationsalgorithmen. Er basiert auf dem dem Austausch (engl. Swap) einzelner Elemente und wurde durch Heap Sort inspiriert.

Die hier vorgestellte Variante ist die CountDown Variante. Für die Implementierung in Excel / VBA wurden alle Indizes um 1 erhöht, damit Arrays mit dem Index 1 beginnen.

Beispiel

Eingabe:

Ausgabe:

Kombinationen mit Subsets k von n (Excel / VBA)

Wed, 20 May 2026 04:35:00 +0100

Abstract

Dieser Algorithmus erzeugt alle Kombinationen von k Elementen aus einer Gesamtmenge mit n Elementen.

Während die Excel Funktion KOMBINATIONEN(n; k) die Anzahl dieser Kombinationen anzeigt, listet der hier vorgestellte Algorithmus alle einzeln, damit sie ggf. untersucht werden können. Das vorgestellte Programm ist schnell - zum Vergleich siehe unten die unter Weitere Links zu findenden Formelansätze.

Beispiel

Eingabe:

Ausgabe:

Literatur

Reingold, Nievergelt, Deo: Combinatorial Algorithms, 1977, Algorithm 5.9, p. 186, ISBN 0-13-152447-X

Fixe Summe aus verschiedenen Zufallsbereichen (Excel)

Wed, 20 May 2026 04:34:00 +0100

Abstract

Sie benötigen sieben Zufallszahlen aus verschiedenen Zahlenbereichen, die zusammen genau 100 ergeben?

Wichtiger Hinweis: Es existiert keine Lösung, wenn die Summe der Untergrenzen größer als 100 ist oder wenn die Summe der Obergrenzen kleiner ist als 100! Dies wird in den Zellen K2:K3 geprüft.

Die Verteilung der Zufallszahlen

Die erzeugten Zufallszahlen im obigen Beispiel sind relativ gleichverteilt.

Bei 1.048.572 erzeugten Reihen von jeweils 7 Zahlen erhält man für die originale Sortierung der Grenzwert-Korridore:

PF_Allocate (VBA)

Wed, 20 May 2026 04:33:00 +0100

Abstract

Falls Sie ein Zufallsportfolio mit einer gegebenen Summe und Ober- und Untergrenzen für jedes Asset erzeugen müssen, können Sie die Funktion PF_Allocate() verwenden:

Appendix – Programmcode PF_Allocate

Bitte beachten Sie dass dieses Programm VBUniqRandInt benötigt (aufruft).

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit
    
Function PF_Allocate(db As Double, _
    vlb As Variant, _
    vub As Variant) As Double()
'Generate a portfolio of assets x1..xN
'x1..xN being random numbers (double) with:
'x1+x2+..xN = db 'budget
'xi >= vlb(i)    'lower bound vector
'xi <= vub(i)    'upper bound vector
'Source (EN): https://www.sulprobil.de/pf_allocate_en/
'Source (DE): https://www.berndplumhoff.de/pf_allocate_de/
'(C) (P) by Bernd Plumhoff 26-Jul-2020 PB V0.11
Dim i As Variant, n As Long
Dim dcumx As Double
Dim dcumlb As Double
Dim dcumub As Double
Dim dxlb As Double
Dim dxub As Double

'Application.Volatile
dcumlb = Application.WorksheetFunction.Sum(vlb)
dcumub = Application.WorksheetFunction.Sum(vub)
If dcumlb > db Or dcumub < db Then
    PF_Allocate = CVErr(xlErrValue)
    Exit Function
End If
n = vlb.Count
ReDim dR(1 To n) As Double
dcumx = 0#
'For i = 1 To n 'Old biased solution
For Each i In VBUniqRandInt(n, n)
    'Source (EN): https://www.sulprobil.de/uniqrandint_en/
    If vlb(i) > vub(i) Then
        PF_Allocate = CVErr(xlErrValue)
        Exit Function
    End If
    dcumlb = dcumlb - vlb(i)
    dcumub = dcumub - vub(i)
    dxlb = db - dcumx - dcumub
    If dxlb < vlb(i) Then dxlb = vlb(i) 'dxlb = Min(..)
    dxub = db - dcumx - dcumlb
    If dxub > vub(i) Then dxub = vub(i) 'dxub = Max(..)
    dR(i) = dxlb + Rnd() * (dxub - dxlb)
    dcumx = dcumx + dR(i)
Next i
PF_Allocate = dR
End Function

Downlaod

Bitte den Haftungsausschluss im Impressum beachten.

Lineare Gleichungssysteme mit rationalen Koeffizienten (VBA)

Wed, 20 May 2026 04:32:00 +0100

Abstract

Lineare Gleichungssysteme der Form A * x = b mit der regulären quadratischen Matrix A und dem Ergebnisvektor b haben eine eindeutige Lösung, da die Determinante von A ungleich Null ist. Sind die Koeffizienten von A und b rationale Zahlen, so ist auch die Lösung rational.

Siehe auch

sbNRN

Exakte Rechnung mit rationalen Zahlen

Literatur

(Externer Link!) Oliver Aberth, A method for exact computation with rational numbers, JCAM, vol 4, no. 4, 1978

Statistiken für gewichtete Werte (VBA)

Wed, 20 May 2026 04:31:00 +0100

Statistiken für gewichtete Werte

Berechnet werden die folgenden Statistiken für gewichtete Werte:

Durchschnitt
Korrelation
Kovarianz
Modus
Median
Schiefe (statistische Grundgesamtheit)
Standardabweichung (Stichprobe und statistische Grundgesamtheit)
Varianz
Wölbung (Kurtose)

Bitte beachten Sie, dass die Gewichte natürliche (d.h. positive ganze) Zahlen sein müssen.

Beispiel

Appendix - Programmcode sbSWV

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

#Const SORTED = False

Function sbSWV(sStat As String, _
        ParamArray vInput() As Variant) As Variant
'Calculate some statistical measures of weighted values
'Source (EN): https://www.sulprobil.de/sbswv_en/
'Source (DE): https://www.berndplumhoff.de/sbswv_de/
'(C) (P) by Bernd Plumhoff 20-Aug-2024 PB V0.81
Dim d As Double, d2 As Double, dSum As Double
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim vV, vV2, vV3, vW 'Variants

With Application.WorksheetFunction
vV = .Transpose(vInput(0))
Select Case sStat
Case "COVAR", "CORREL"
    vV2 = .Transpose(vInput(1))
    vW = .Transpose(vInput(2))
Case Else
    vW = .Transpose(vInput(1))
End Select
On Error GoTo errhdl
i = vV(1) 'Force error in case of vertical arrays
On Error GoTo 0
If UBound(vV) <> UBound(vW) Then
    'Arrays of values and of weights must have same dimension
    sbSWV = CVErr(xlErrNum)
    Exit Function
End If
Select Case UCase(sStat)
Case "AVERAGE"
    sbSWV = .SumProduct(vV, vW) / .Sum(vW)
Case "CORREL"
    vV3 = vV
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    d2 = .SumProduct(vV2, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV3(i) = vW(i) * (vV(i) - d) * (vV2(i) - d2)
        vV(i) = vW(i) * (vV(i) - d) ^ 2#
        vV2(i) = vW(i) * (vV2(i) - d2) ^ 2#
    Next i
    sbSWV = .Sum(vV3) / Sqr(.Sum(vV) * .Sum(vV2))
Case "COVAR"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    d2 = .SumProduct(vV2, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = vW(i) * (vV(i) - d) * (vV2(i) - d2)
    Next i
    sbSWV = .Sum(vV) / dSum
Case "KURT"
    n = .Sum(vW)
    ReDim dV(1 To n) As Double
    k = 1
    For i = 1 To UBound(vW)
      For j = 1 To vW(i)
        dV(k) = vV(i)
        k = k + 1
      Next j
    Next i
    sbSWV = .Kurt(dV)
Case "MODE"
    k = .Max(vW)
    If k < 2 Then
        sbSWV = CVErr(xlErrNA)
        Exit Function
    End If
    sbSWV = vV(.Match(.Max(vW), vW, False))
Case "MEDIAN"
    If .Min(vW) < 1 Then
        sbSWV = CVErr(xlErrNA)
        Exit Function
    End If
    k = 0
    j = .Sum(vW)
    m = j Mod 2
    For i = LBound(vW) To UBound(vW)
        If vW(i) Mod 1 <> 0 Then
            sbSWV = CVErr(xlErrNum)
            Exit Function
        End If
        #If Not SORTED Then
            'Ensure ascending values in case input is unsorted.
            'This simple bubble sort leads to a quadratic runtime
            'but it's still quicker on 50 input values or more than
            'Lorimer Miller's nifty worksheet function approach
            '=LOOKUP(2,1/FREQUENCY(SUM(B1:B50)/2,SUMIF(A1:A50,"<="&A1:A50,B1:B50)),A1:A50)
            'BTW: Lorimer's approach is different from Excel's MEDIAN
            '(see below); and his other elegant array formula
            '=MEDIAN(IF(TRANSPOSE(ROW(A1:A1000))<=B1:B50,A1:A50))
            'calculates like Excel's MEDIAN but IMHO it's way too slow
            For n = i + 1 To UBound(vW)
                If vV(n) < vV(i) Then
                    d = vV(i)
                    vV(i) = vV(n)
                    vV(n) = d
                    d = vW(i)
                    vW(i) = vW(n)
                    vW(n) = d
                End If
            Next n
        #End If
        k = k + vW(i)
        Select Case 2 * k
        Case j + m
            If m = 0 Then
                #If Not SORTED Then
                    'Ensure vV(i + 1) is next greater value
                    For n = i + 2 To UBound(vW)
                        If vV(n) < vV(i + 1) Then
                            vV(i + 1) = vV(n)
                        End If
                    Next n
                #End If
                'Here Lorimer's function mentioned above would
                'return vV(i), the lower value
                sbSWV = (vV(i) + vV(i + 1)) / 2#
            Else
                sbSWV = vV(i)
            End If
            Exit Function
        Case Is > j + m
            sbSWV = vV(i)
            Exit Function
        End Select
    Next i
Case "SKEW.P"
    n = .Sum(vW)
    ReDim dV(1 To n) As Double
    k = 1
    For i = 1 To UBound(vW)
      For j = 1 To vW(i)
        dV(k) = vV(i)
        k = k + 1
      Next j
    Next i
    sbSWV = .Skew_p(dV)
Case "STDEV"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = Abs(vV(i) - d) ^ 2#
    Next i
    sbSWV = Sqr(.SumProduct(vV, vW) / (dSum - 1#))
Case "STDEV.P"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = Abs(vV(i) - d) ^ 2#
    Next i
    sbSWV = Sqr(.SumProduct(vV, vW) / dSum)
Case "VAR"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = vW(i) * (vV(i) - d) ^ 2#
    Next i
    sbSWV = .Sum(vV) / (dSum - 1#)
Case Else
    sbSWV = CVErr(xlErrValue)
End Select
Exit Function
errhdl:
'Transpose variants to be able to address them
'with vV(i), not vV(i,1)
vV = .Transpose(vV)
vW = .Transpose(vW)
Select Case sStat
Case "COVAR", "CORREL"
    vV2 = .Transpose(vV2)
End Select
Resume Next
End With
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

ApplicationVersion (VBA)

Wed, 20 May 2026 04:30:00 +0100

{Sturgeon’s Law} “Sure, 90% of all software is crap. That’s because 90% of everything is crap.” [Mary Shaw, Carnegie-Mellon University]

Abstract

Microsoft hat in seiner unendlichen Weisheit beschlossen, ab Excel 2016 den Wert von Application.Version nicht über 16 hinaus zu erhöhen.

Meine Funktion ApplicationVersion behebt dies und gibt einen verständlichen Versionsstring zurück.

Appendix – Programmcode ApplicationVersion

Bitte den Haftungsausschluss im Impressum beachten.

Function ApplicationVersion(Optional bShowBuild365 As Boolean = True) As String
'Returns MS Excel's version - with a little kludge
'Source (EN): https://www.sulprobil.de/applicationversion_en/
'Source (DE): https://www.berndplumhoff.de/applicationversion_de/
'(C) (P) by Bernd Plumhoff 20-Oct-2024 PB V0.61
Dim n As Integer
With Application
n = Val(.Version)
Select Case n
Case 16
  ApplicationVersion = "Excel 2016"
  On Error Resume Next 'We know what we are doing
  'Excel 2024 (LTSC) introduced ValueToText
  n = Val(.ValueToText(19))
  If n = 19 Then
    If .Build = "17932" Then
      ApplicationVersion = "Excel 2024"
    Else
      If bShowBuild365 Then
        'When all of them are 365 you might want to know the build.
        ApplicationVersion = "Excel 365 (Build " & .Build & ")"
      Else
        ApplicationVersion = "Excel 365"
      End If
    End If
  Else
    'Excel 2021 (LTSC) introduced RandArray
    n = .RandArray(1, 1, 18, 18, True)(1)
    If n = 18 Then
      ApplicationVersion = "Excel 2021"
    Else
      'Excel 2019 introduced TextJoin
      n = Val(.TextJoin(" ", True, "17"))
      If n = 17 Then ApplicationVersion = "Excel 2019"
    End If
  End If
  On Error GoTo 0
Case 15
  ApplicationVersion = "Excel 2013"
Case 14
  ApplicationVersion = "Excel 2010"
Case 12
  ApplicationVersion = "Excel 2007"
Case 11
  ApplicationVersion = "Excel 2003"
Case 10
  ApplicationVersion = "Excel 2002"
Case 9
  ApplicationVersion = "Excel 2000"
Case 8
  ApplicationVersion = "Excel 97"
Case 7
  ApplicationVersion = "Excel 7/95"
Case 5
  ApplicationVersion = "Excel 5"
Case Else
  ApplicationVersion = "[Error]"
End Select
End With
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbRebalancedReturn (VBA)

Wed, 20 May 2026 04:29:00 +0100

Abstract

Die Neugewichtung eines Portfolios ist der Prozess, alle Assetklassen eines Portfolios hinsichtlich ihrer Gewichtung wieder wie gewünscht auszurichten. Sie bringen Ihr Portfolio wieder zur gewünschten Mischung von Aktien, Bonds, Cash und anderen Produkten zurück, wenn sie nicht mehr mit Ihren Plänen oder Limiten übereinstimmen.

Ein Beispiel:

Appendix – Programmcode sbRebalancedReturn

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Const CMaxDouble = 1.79769313486231E+308
Function sbRebalancedReturn(rARM As Range, _
    rIWV As Range, _
    Optional ByVal lRF As Long = 0, _
    Optional dDT As Double = CMaxDouble) As Variant
'RebalancedReturn calculates balanced returns for a
'portfolio with given
'rARM - asset return matrix (columns show different
'       assets, rows show returns per asset over time)
'rIWV - initial weight vector for the assets
'lRF  - rebalancing frequency (in time steps = rows)
'       If lRF > 0 then each lRF time step rebalancing
'       will take place
'       If lRF = 0 then no rebalancing will take place
'       If lRF < 0 then each -lRF time step after last
'       rebalance portfolio will be rebalanced again
'dDT  - drift tolerance %, if any asset has drifted by
'       by more than dDT (relative measure) then the
'       portfolio will be rebalanced AND the internal
'       rebalancing frequency count will be reset
'The output matrix shows portfolio returns % in first
'column, then end-of-period asset weights and finally
'boolean output values in last column, showing whether
'a rebalance happened.
'This function has been inspired by Andreas Steiner's
'similar function.
'Source (EN): https://www.sulprobil.de/sbrebalancedreturn_en/
'Source (DE): https://www.berndplumhoff.de/sbrebalancedreturn_de/
'(C) (P) by Bernd Plumhoff 19-Mar-2011 PB V0.2
Dim i As Long, j As Long, k As Long, n As Long, m As Long
Dim bDrifted As Boolean, bForceRB As Boolean

n = rARM.Rows.Count 'Number of observations
m = rARM.Columns.Count 'Number of assets

If m <> rIWV.Columns.Count Or _
    rIWV.Rows.Count <> 1 Then
    sbRebalancedReturn = CVErr(xlErrValue)
    Exit Function
End If

ReDim w0(1 To m) As Double, x(1 To m) As Double
ReDim r(1 To n, 1 To m) As Double

If lRF = 0 Then lRF = n
If lRF < 0 Then
    lRF = -lRF
    bForceRB = True
Else
    bForceRB = False
End If

ReDim vR(1 To n, 1 To m + 2)
For i = 1 To m
    x(i) = rIWV(i)
    w0(i) = x(i)
    For j = 1 To n
        r(j, i) = rARM(j, i)
    Next j
Next i

k = 1
'Model rebalancing tolerance
For i = 1 To n
    If bDrifted And bForceRB Then k = i
    'Calculate period start weights
    vR(i, m + 2) = (i - k) Mod lRF = 0 Or bDrifted
    If vR(i, m + 2) Then
        For j = 1 To m
            x(j) = w0(j)
        Next j
    Else
        For j = 1 To m
            x(j) = vR(i - 1, 1 + j)
        Next j
    End If
    'Calculate portfolio return
    For j = 1 To m
        vR(i, 1) = vR(i, 1) + x(j) * r(i, j)
    Next j
    'Calculate period end weights & check for drift
    bDrifted = False
    For j = 1 To m
        vR(i, 1 + j) = x(j) * (1# + r(i, j)) / (1# + vR(i, 1))
        bDrifted = bDrifted Or Abs(vR(i, 1 + j) - w0(j)) > dDT
    Next j
Next i
sbRebalancedReturn = vR
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

ArrayDim (VBA)

Wed, 20 May 2026 04:28:00 +0100

Abstract

Wie ermittelt man die Anzahl der Dimensionen eines Arrays?

Appendix – ArrayDim Programmcode

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function ArrayDim(v As Variant) As Long
'Returns number of dimensions of an array or 0 for
'an undimensioned array or -1 if no array at all.
'Source (EN): https://www.sulprobil.de/arraydim_en/
'Source (DE): https://www.berndplumhoff.de/arraydim_de/
'(C) (P) by Bernd Plumhoff 10-May-2010 PB V0.1
Dim i As Long
ArrayDim = -1
If Not IsArray(v) Then Exit Function
On Error Resume Next
'Err.Clear 'Not necessary
Do While IsNumeric(UBound(v, i + 1))
  If Err.Number <> 0 Then Exit Do
  i = i + 1
Loop
ArrayDim = i
End Function

Sub test()
'Expected output: -1, 0, 1, 3
Dim v
Dim w()
Dim x(1 To 2)
Dim y(1, 2, 3)
Debug.Print ArrayDim(v)
Debug.Print ArrayDim(w)
Debug.Print ArrayDim(x)
Debug.Print ArrayDim(y)
End Sub

Download

Bitte den Haftungsausschluss im Impressum beachten.

Anteilsveränderung als Bruch (Excel/VBA)

Wed, 20 May 2026 04:27:00 +0100

Abstract

Manchmal müssen Sie Anteilsveränderungen einfach darstellen. Das können Sie mit Brüchen zeigen:

Beispiel: Eine Erbengemeinschaft besteht aus den Herren Müller, Meier und Schulz. Meier verstirbt ohne Erben, sein Anteil wird aufgeteilt. Schulz stirbt auch, sein Anteil geht zu 2/3 an seine Witwe und zu 1/3 an sein einziges Kind. Bitte beachten Sie, dass Sie diese Anteile mit =1/3 * 2/3 respektive =1/3 * 1/3 eingeben müssen, wobei das erste 1/3 den Originalanteil von Schulz darstellt.

Stichprobe normalverteilen (VBA)

Wed, 20 May 2026 04:26:00 +0100

Abstract

Sie haben 11.256 Weihnachtsbäume. Ein Kunde möchte Ihnen 1.500 davon abkaufen. Die einzige Bedingung: die durchschnittliche Länge soll 6,50 Meter betragen.

Sie würden nun gern die Restmenge Ihrer Weihnachtsbäume möglichst normalverteilt haben:

Wie können Sie dies erreichen?

Eine Beispielrechnung

Angenommen, Sie haben die oben gezeigte Menge an Bäumen mit den angegebenen Längen.

Eine erste interessante Rechnung ist sicherlich, inwieweit Ihre Ausgangsmenge bereits normalverteilt ist. Die Schiefe ermitteln wir mittels der Funktion sbSWV: sie beträgt gerundet =sbSWV(“SKEW.P”;$A$4:$A$21;B$4:B$21) = -0,35. Der Exzess (Maß für die Wölbung) beträgt gerundet =sbSWV(“KURT”;$A$4:$A$21;B$4:B$21) = 0,95. Wie wir am oben gezeigten Diagramm am gelb-orangen Graphen sehen können, ist diese Ausgangsmenge bereits “einigermaßen” normalverteilt.

ManageOneDriveSync (VBA)

Sun, 17 May 2026 07:08:00 +0100

Abstract

Microsoft OneDrive ist ein Filehosting-Dienst von Microsoft. Mithilfe dieses Dienstes kann man Dateien hochladen und auch von anderen Diensten aus abrufen und bearbeiten.

Dieser Dienst beansprucht allerdings etwas Zeit, um Dateien zu synchronisieren. Die VBA Subroutine Check_OneDrive_Sync prüft, ob ein Programm bereits vollständig synchronisiert wurde (d.h. lauffähig ist).

Für die Erstellung oder Bearbeitung vieler Dateien empfiehlt es sich manchmal, OneDrive vorübergehend auszuschalten. Dies ermöglicht die VBA Subroutine ManageOnedriveSync.

Programmcode Check_OneDrive_Sync

Bitte beachten: Diese Subroutine benötigt das Modul (externer Link!) LibFileTools.

Write-Log (PowerShell)

Sun, 17 May 2026 06:52:00 +0100

“Knowing is not enough; we must apply. Willing is not enough; we must do.” [Johann Wolfgang von Goethe]

Abstract

PowerShell ist eine Microsoft Windows basierte objektorientierte Script- oder Programmiersprache. Sie hat eine eigene Befehlszeilenschnittstelle.

Normalerweise würde ich eine plattform-unabhängige Sprache wie Python bevorzugen. Aber innerhalb einer Windows-Umgebung kann man fast alles mit PowerShell bewerkstelligen. Und manchmal möchte ich nicht alles mit Excel / VBA machen. PowerShell kann Aufgaben im Hintergrund oder zu festgelegten Zeiten etc. durchführen.

Feiertage (Excel/VBA)

Sat, 16 May 2026 10:44:00 +0100

Abstract

Wollen Sie herausfinden, ob ein Datum ein deutscher Feiertag ist? Oder ob es ein Feiertag in einem Bundesland ist?

Hier sind alle Feiertage von 2023 bis 2100 gezeigt. Sie können die Liste manuell ändern, z. B. Feiertage hinzufügen oder entfernen. Diese Liste kann mit dem unten angebotenen Programm Feiertage_generieren.xlsm automatisch erzeugt werden, wobei aber historische Feiertagsänderungen (z. B. Abschaffung des Buß- und Bettages seit 1995 mit Ausnahme Sachsens) und Gebietsreformen (z. B. Wiedervereinigung 1990) nicht berücksichtigt sind.

Gemeinkostenumlage (Excel / VBA)

Sat, 16 May 2026 10:44:00 +0100

Abstract

Wenn Sie Gemeinkosten auf Kostenträger verrechnen müssen, ergibt sich häufig das Problem, dass die Summe der umgelegten Kosten nicht cent-genau mit der Ursprungssumme übereinstimmt.

Hier hilft die benutzerdefinierte Excel Funktion RoundToSum.

Ein praktisches Beispiel

Vorgestellt wird eine Gemeinkostenumlage, bei der sich die einzelnen Summanden cent-genau zu den jeweiligen Gesamtsummen addieren.

Zunächst legen Sie die Gemeinkosten auf alle anderen Kostenstellen um:

Schlüsselbezeichnung	pro Kopf	m²	gleich	Gewichtung
Gesamt	102	2685	14	16
GF	1	50	1	2
Sekretariat	1	40	1	1
RW	3	100	1	1
Controlling	1	30	1	1
Personal	2	50	1	1
ÖA/Werbung	3	50	1	2
Auszub.	3		1	1
Betriebsrat	1	15	1	1
Werkstatt	1	12 250	1	1
Werkstatt	2	10 350	1	1
Fuhrpark		100	1	1
Fertigung1	20	500	1	1
Fertigung2	20	550	1	1
Fertigung3	25	600	1	1

Diese erste Gemeinkostenumlage erfolgt mit einer Matrixformel und dem Aufruf einer Rundungskorrektur, damit die einzelnen Summanden cent-genau die Spaltensummen pro Kostenstelle ergeben:

Excel Don'ts

Sat, 16 May 2026 10:43:00 +0100

“Wenn ich mein Leben noch einmal leben könnte, würde ich die gleichen Fehler machen. Aber ein bisschen früher damit ich mehr davon habe.” [Marlene Dietrich]

Abstract

Kritik sollte konstruktiv sein. Im Allgemeinen versuche ich positiv zu zeigen, was man wie am besten machen könnte. Aber in den mehr als 30 Jahren Excel Praxis sah ich einige Beispiele, die besser hätten vermieden werden sollen. Eine Positivliste zur Excel / VBA zeige ich hier.

Zellenbasierte Diagramme (Excel)

Sat, 16 May 2026 05:40:00 +0100

Dietmar P. stellte ein interessantes zellenbasiertes Diagramm vor. Ich änderte und erweiterte es etwas, z. B. mit automatischer Skalierung und zwei neuen Parametern:

Ein Nummernformat, um eine allgemeine Formatänderung zu ermöglichen.
Einen Wahrheitswert-Parameter, um ggf. die Farben Grün und Rot vertauschen zu können. Wenn man einen Berater beauftragt, möchte man vielleicht ein Unterschreiten des Budgets grün anzeigen, aber im Falle von Verkaufszahlen sollte es besser rot sein.

Formel in H9:

Budgetkontrolle (Excel)

Fri, 15 May 2026 13:01:00 +0100

“If you want creativity, take a zero off your budget. If you want sustainability, take off two zeros.” [Jaime Lerner]

Abstract

Dies ist eine einfache Budgetplanung und -kontrolle.

In die Zellen B5:E5 geben Sie die jährlichen Planbudgets Ihrer Abteilungen oder Kostenstellen ein.

In die Zellen G7:J18 gehören die saisonalen Gewichte der Abteilungen. Als Beispiele sind Festartikel (Ostern und Weihnachten) sowie Badeartikel gezeigt. Der Einkauf hat 2 Monate vorher entsprechenden Aufwand.

Linearer Breakdown (Excel)

Fri, 15 May 2026 13:00:00 +0100

“I’m not such a big fan of having a linear answer to things.” [Adam Driver]

Abstract

Wie kann man jährliche Daten

in monatliche Daten linear stückweise umwandeln

Geben Sie in A2:B5 Ihre jährlichen Daten ein. In A8:A56 geben Sie Ihre Monatsenddaten chronologisch sortiert ein. Für den Anfang geben Sie in B8 ein: =B2/12. In B9 geben Sie =SVERWEIS(DATUM(JAHR($A9)-1;12;31);A$8:B8;2)+(MONAT($A9))*(SVERWEIS(JAHR($A9);$A$2:$B$5;2)-SVERWEIS(DATUM(JAHR($A9)-1;12;31);A$8:B8;2)*12)/78 ein und kopieren nach unten. In D8 geben Sie =STABW.N(B9:B56) ein. Falls Ihre monatlichen Daten cent-genau die Summe der jährlichen Daten ausmachen müssen, geben Sie in C9 ein =RUNDEN(B9;2) und in D10: =RUNDEN(SUMME(B$9:B10);2)-SUMME(C$9:C9) und kopieren wieder nach unten. Dies ist lediglich eine pragmatische Rundungsmethode ohne VBA. Falls Sie diese Rundung korrekt durchführen wollen, verwenden Sie bitte RoundToSum.

sbRandGeneral (VBA)

Thu, 14 May 2026 16:01:00 +0100

“It pays to be obvious, especially if you have a reputation for subtlety.” [Isaac Asimov]

Abstract

Wenn Sie eine schrittweise lineare Verteilung von Zufallszahlen benötigen, dann empfehle ich meine benutzerdefinierte Funktion sbRandGeneral.

Bemerkung: Man kann jede beliebige Verteilung mit einer festgelegten Mindestgenauigkeit durch eine schrittweise lineare Verteilung wie hier angeboten approximieren.

Dokumentation

Die Dokumentation zu dieser Funktion:

Bitte den Haftungsausschluss im Impressum beachten.

080102_PB_01_General_Doc.pdf [30 KB PDF Datei, ohne Gewähr]

sbRandTrigen (VBA)

Thu, 14 May 2026 15:47:00 +0100

Abstract

Bitte beachten dass sbRandTrigen sbRandTriang benötigt und aufruft.

Dokumentation

Die Dokumentation zu dieser Funktion:

Bitte den Haftungsausschluss im Impressum beachten.

071228_PB_02_Trigen_Doc.pdf [38 KB PDF Datei, ohne Gewähr]

Appendix – Programmcode sbRandTrigen

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbRandTrigen(dBottom As Double, dMode As Double, _
    dTop As Double, dBottomPerc As Double, _
    dTopPerc As Double, Optional dRandom = 1#) As Double
'Generates dMin random number, Triang distributed
'with given first and last decile
'[see Vose: Risk Analysis, 2nd ed., p. 129]
'Source (EN): https://www.sulprobil.de/sbrandgeneral_en/
'Source (DE): https://www.berndplumhoff.de/sbrandgeneral_de/
'(C) (P) by Bernd Plumhoff 19-Nov-2011 PB V0.32
'Similar to @RISK's (C) RiskTrigen function.
'sbRandTrigen(bottom, mode, top, bottom percentile, top percentile)
'specifies a triangular distribution with three points — one
'at the mode and two at the specified bottom and top percentiles.
'The bottom percentile and top percentile are values between
'0 and 100. Each percentile value gives the percentile of the
'total area under the triangle that is on the left side of the
'given point.
'Example:
'sbRandTrigen(1,8,10,20,95) will call
'sbRandTriang(-6.13212712795534, 8, 11.8648937411641).
'Please ensure that you execute Randomize before you call 
'this function for the first time.

Static dBottomLast As Double
Static dModeLast As Double
Static dTopLast As Double
Static dBottomPercLast As Double
Static dTopPercLast As Double
Static dMin As Double
Static dMax As Double
Dim dMaxNew As Double
Dim da0 As Double, da1 As Double, da2 As Double
Dim da3 As Double, da4 As Double
Dim dfe As Double, df1e As Double
Dim dBottomPerc2 As Double, dTopPerc2 As Double
Dim i As Long

If dBottom = dBottomLast And dMode = dModeLast And dTop = dTopLast _
   And dBottomPerc = dBottomPercLast And dTopPerc = dTopPercLast _
   And Not IsError(dMin) Then
    sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
    Exit Function
End If

dBottomLast = dBottom
dModeLast = dMode
dTopLast = dTop
dBottomPercLast = dBottomPerc
dTopPercLast = dTopPerc

dBottomPerc2 = dBottomPerc / 100#
dTopPerc2 = 1# - dTopPerc / 100#
If dMode <= dBottom Or dTop <= dMode Then
    dMin = CVErr(xlErrValue) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If
If dBottomPerc2 < 0# Or dTopPerc2 < 0# Then
    dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If

If dTopPerc2 = 0# Then
    If dBottomPerc2 = 0# Then
        sbRandTrigen = sbRandTriang(dBottom, dMode, dTop, dRandom)
        Exit Function
    End If
    sbRandTrigen = sbRandTrigen(dBottom, dMode, dTop, dBottomPerc2, dTopPerc2)
    Exit Function
End If

da4 = dBottomPerc2 * dTopPerc2 - dBottomPerc2 + 1# - 2# * dTopPerc2 + dTopPerc2 ^ 2#
da3 = -2# * dBottomPerc2 * dTopPerc2 * dTop - 2# * dBottomPerc2 * dTopPerc2 * dMode - _
      4# * dTop + 4# * dBottomPerc2 * dTop + 2# * dTopPerc2 * dMode + 4# * dTopPerc2 * _
      dTop + 2# * dTopPerc2 * dBottom - 2# * dTopPerc2 ^ 2# * dMode - _
      2# * dTopPerc2 ^ 2# * dBottom
da2 = dBottomPerc2 * dTopPerc2 * dTop ^ 2# + 4# * dBottomPerc2 * dTopPerc2 * dMode * _
      dTop + dBottomPerc2 * dTopPerc2 * dMode ^ 2# - 6# * dBottomPerc2 * dTop ^ 2# + _
      6# * dTop ^ 2# - 4# * dTopPerc2 * dMode * dTop - 2# * dTopPerc2 * dTop ^ 2# - 2# * _
      dTopPerc2 * dBottom * dMode - 4# * dTopPerc2 * dBottom * dTop + dTopPerc2 ^ 2# * _
      dMode ^ 2# + 4# * dTopPerc2 ^ 2# * dBottom * dMode + dTopPerc2 ^ 2# * dBottom ^ 2#
da1 = -2# * dBottomPerc2 * dTopPerc2 * dMode * dTop ^ 2# - 2# * dBottomPerc2 * dTopPerc2 * _
      dMode ^ 2# * dTop + 4# * dTop ^ 3# * dBottomPerc2 - 4# * dTop ^ 3# + 2# * dTopPerc2 * _
      dMode * dTop ^ 2# + 4# * dTopPerc2 * dBottom * dMode * dTop + 2# * dTopPerc2 * _
      dBottom * dTop ^ 2# - 2# * dTopPerc2 ^ 2# * dBottom * dMode ^ 2# - 2# * _
      dTopPerc2 ^ 2# * dBottom ^ 2# * dMode
da0 = dBottomPerc2 * dTopPerc2 * dMode ^ 2# * dTop ^ 2# - dBottomPerc2 * dTop ^ 4# + dTop ^ 4# - _
      2# * dTopPerc2 * dBottom * dMode * dTop ^ 2# + dTopPerc2 ^ 2# * dBottom ^ 2# * dMode ^ 2#
     
dMax = dTop + (dTop - dMode) / (1# - dTopPerc2) ^ 2#

'Newton iteration
Do While Abs(dMaxNew - dMax) > 0.000000000001

    i = i + 1
    If i > 30 Then
        If Abs(dfe) > 0.000000000001 Then
            dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
            sbRandTrigen = CVErr(xlErrValue)
            Exit Function
        Else
            Exit Do
        End If
    End If
    dMaxNew = dMax
    dfe = da4 * dMaxNew ^ 4# + da3 * dMaxNew ^ 3# + da2 * dMaxNew ^ 2# + da1 * dMaxNew + da0
    df1e = 4# * da4 * dMaxNew ^ 3# + 3# * da3# * dMaxNew ^ 2# + 2# * da2 * dMaxNew + da1
    dMax = dMax - dfe / df1e

Loop

dMin = dMax - (dMax - dTop) ^ 2# / dTopPerc2 / (dMax - dMode)
sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbRandTriang (VBA)

Thu, 14 May 2026 14:47:00 +0100

Abstract

Die Dreiecksverteilung ist eine stetige Wahrscheinlichkeitsverteilung, deren Dichtefunktion wie ein Dreieck aussieht. Es ist eine einfache Verteilung, weil Sie lediglich ihr Minimum, ihren Median und ihr Maximum kennen müssen:

Im englischen Sprachraum wird diese Verteilung auch Distribution of Missing Data genannt, weil für ihre Bestimmung nur ein Minimum an Information benötigt wird. Diese Verteilung wird oft zur Simulation von Expertenwissen eingesetzt oder wenn eine genauere Datenermittlung zu schwierig oder zu teuer erscheint.

sbRandSum1 (VBA)

Thu, 14 May 2026 12:40:00 +0100

Abstract

Wir erzeugen n Zufallszahlen mit einer Bedingung: Die Summe aller erzeugten Zahlen soll 1 sein. Dies kann man mit vielen verschiedenen Ansätzen erreichen.

Drei mögliche Ansätze sind:

Reduziere den Freiheitsgrad sukzessive: Erzeuge die erste Zufallszahl, danach die zweite im Bereich [0,1-Erste_Zahl), dann die dritte [0,1-Erste_Zahl-Zweite_Zahl), …, die letzte Zahl muss schließlich gleich 1-Summe_aller_anderen_Zahlen sein.
Erzeuge n Zufallszahlen und dividiere sie durch ihre Summe.
Simuliere die Teilung einer Torte: wo immer man schneidet, man kann nicht mehr und nicht weniger als die ganze Torte verteilen.

sbRandIntFixSum (VBA)

Thu, 14 May 2026 11:46:00 +0100

Abstract

Sie wollen lCount ganze Zufallszahlen zwischen lMin und lMax mit der Summe lSum erzeugen?

Diese benutzerdefinierte Funktion ist eng mit sbLongRandSumN verwandt.

Appendix Programmcode sbRandIntFixSum

Dieses Programm benötigt (ruft auf) sbRandTriang.

Bitte den Haftungsausschluss im Impressum beachten.

Function sbRandIntFixSum(lSum As Long, lMin As Long, _
  lMax As Long, Optional lCount As Long = 0, _
  Optional bUseRandTriang As Boolean = True, _
  Optional bVolatile As Boolean = False) As Variant
'Returns lCount (or selected cell count in case a range is select when
'called as a matrix formula) random integers between lMin and lMax
'which sum up to lSum. If bUseRandTriang the sbRandTriang distribution
'is used to "bias" the randomness to be "less extreme".

'Error values:
'#NUM!   - No solution exists
'#VALUE! - lCount is less than 1
'Source (EN): https://www.sulprobil.de/sbrandintfixsum_en/
'Source (DE): https://www.berndplumhoff.de/sbrandintfixsum_de/
'(C) (P) by Bernd Plumhoff 05-Aug-2020 PB V0.3

Dim i As Long
Dim lRnd As Long, lMinPrev As Long
Dim lRow As Long, lCol As Long

With Application

If TypeName(.Caller) = "Range" And lCount = 0 Then
  lCount = .Caller.Count
  ReDim lR(1 To .Caller.Rows.Count, 1 To .Caller.Columns.Count) As Long
ElseIf lCount < 1 Then
  sbRandIntFixSum = CVErr(xlErrValue)
  Exit Function
Else
  ReDim lR(1 To lCount, 1 To 1) As Long
End If

Randomize
If bVolatile Then .Volatile

For lRow = 1 To UBound(lR, 1)
  For lCol = 1 To UBound(lR, 2)
    lMinPrev = lMin
    lMin = .RoundUp(.Max(lMin, .Min(lSum / lCount, lSum / lCount _
           - (lCount - 1) * (lMax - lSum / lCount))), 0)
    lMax = .RoundDown(.Min(lMax, .Max(lSum / lCount, lSum / lCount _
           + (lCount - 1) * (lSum / lCount - lMinPrev))), 0)
    If lMin > lMax Or lSum / lCount <> .Median(lMin, lMax, lSum / lCount) Then
      'No solution exists
      sbRandIntFixSum = CVErr(xlErrNum)
      Exit Function
    End If
    If bUseRandTriang Then
      If lMin = lMax Then
        lRnd = lMin
      Else
        lRnd = Int(sbRandTriang(CDbl(lMin), lSum / lCount, CDbl(lMax)) + 0.5)
      End If
    Else
      lRnd = Int(Rnd() * (lMax - lMin + 1) + lMin)
    End If
    lR(lRow, lCol) = lRnd
    lSum = lSum - lRnd
    lCount = lCount - 1
  Next lCol
Next lRow

sbRandIntFixSum = lR
End With

End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbGrowthSeries (VBA)

Thu, 14 May 2026 10:47:00 +0100

Abstract

Sie können Zufallszahlen mit einer kumulierten Wachstumsrate dblRate, mit einer maximalen relativen Änderungsrate pro Zeitschritt dblMaxRatePerStep und mit einem optionalen Startwert dblStartVal erzeugen. Die Anzahl der Zeitschritte (Perioden) wird implizit durch die Anzahl der ausgewählten Zellen gewählt, in die der Funktionsaufruf als Matrixformel mit STRG + SHIFT + ENTER eingegeben wird. Dies ist eine spezielle Art von Brownscher Brücke.

Appendix – Programmcode sbGrowthSeries

Bitte den Haftungsausschluss im Impressum beachten.

Iman Conover (Excel / VBA)

Thu, 14 May 2026 10:41:00 +0100

“When your work speaks for itself, don’t interrupt.” [Henry J. Kaiser]

Abstract

Falls Sie korrelierte Zufallszahlen erzeugen müssen, ist die Iman Conover Methode besser als die Cholesky Zerlegung.

1982 veröffentlichten Iman und Conover ihren ursprünglichen Artikel (externer Link!) “A distribution-free approach to inducing rank correlation among input variables”.

Rick Wicklin schrieb dazu im Jahr 2021 (externer Link!) “Simulate correlated variables by using the Iman-Conover transformation”. Sein Artikel enthält eine SAS Implementierung der Iman Conover Methode.

sbGenerateTeams (VBA)

Thu, 14 May 2026 09:46:00 +0100

“For many people my software is something that you install and forget. I like to keep it that way.” [Wietse Venema]

Abstract

Sie und Ihre 15 Freunde wollen in 4 Teams spielen mit je 4 Spielern und Sie fragen sich, wie Sie die Teams zufällig aber möglichst gleichstark aufstellen können?

So kann man dies erreichen:

Dieses Programm vereint mehrere Funktionalitäten, die ich gern nutze:

Die Klasse SystemState reduziert die Laufzeit.

sbGenerateTestData (VBA)

Thu, 14 May 2026 08:46:00 +0100

“It is practically impossible to teach good programming style to students that have had prior exposure to BASIC. As potential programmers, they are mentally mutilated beyond hope of regeneration.” [E. W. Dijkstra]

Abstract

Wenn Sie eine Anwendung oder ein Programm auf Herz und Nieren testen wollen, benötigen Sie häufig Testdaten.

Diese Anwendung soll Sie dabei unterstützen, zufällige Testdaten in numerischer Form oder als Text zu erzeugen.

Wollen Sie beispielsweise sechs Wahrheitswerte, davon 50% WAHR und 50% FALSCH, einmal in der erzeugten Reihenfolge und einmal zufällig gemischt:

UniqRandInt (VBA)

Thu, 14 May 2026 07:46:00 +0100

“Few things are harder to put up with than the annoyance of a good example.” [Mark Twain]

Abstract

Manchmal benötigt man ganze Zufallszahlen, die sich nicht (oder nur begrenzt häufig) wiederholen.

Appendix – UniqRandInt Code

Bitte den Haftungsausschluss im Impressum beachten.

'If lRange >> n then set LATE_INITIALISATION to true. For example,
'if lRange=1,000,000 and if 1,000 cells are selected (n=1000).
#Const LATE_INITIALISATION = True
'If random integers may occur more than once, allow repetitions
#Const ALLOW_REPETITION = True

#If ALLOW_REPETITION Then
Function UniqRandInt(n As Long, ByVal lRange As Long, _
  Optional lMaxOccurence As Long = 1) As Variant
#Else
Function UniqRandInt(n As Long, ByVal lRange As Long) As Variant
#End If
'Returns n unique (=non-repeating) random integers within 1..lRange,
'lRange >= n. Set ALLOW_REPETITION = True and call with
'lMaxOccurences > 1 if random integers may occur more than once.
'Source (EN): https://www.sulprobil.de/uniqrandint_en/
'Source (DE): https://www.berndplumhoff.de/uniqrandint_de/
'(C) (P) by Bernd Plumhoff 30-Oct-2024 PB V1.04

Static bRandomized As Boolean
Dim vA             As Variant
Dim vR             As Variant
Dim i              As Long
Dim j              As Long
Dim lr             As Long

If Not bRandomized Then
  Randomize
  bRandomized = True
End If

#If ALLOW_REPETITION Then
  If lMaxOccurence < 1 Then
    UniqRandInt = CVErr(xlErrNum)
    Exit Function
  End If
  lRange = lRange * lMaxOccurence
#End If

If n > lRange Then
  UniqRandInt = CVErr(xlErrValue)
  Exit Function
End If

ReDim vR(1 To n) As Variant

ReDim vA(1 To lRange)
#If Not LATE_INITIALISATION Then
  For i = 1 To lRange
    #If ALLOW_REPETITION Then
      vA(i) = Int((i - 1) / lMaxOccurence) + 1
    #Else
      vA(i) = i
    #End If
  Next i
#End If

i = 1
For j = 1 To UBound(vR, 1)
  lr = Int(((lRange - i + 1) * Rnd) + 1)
  #If LATE_INITIALISATION Then
    If vA(lr) = 0 Then
      #If ALLOW_REPETITION Then
        vR(j) = Int((lr - 1) / lMaxOccurence) + 1
      #Else
        vR(j) = lr
      #End If
    Else
  #End If
      vR(j) = vA(lr)
  #If LATE_INITIALISATION Then
    End If
    If vA(lRange - i + 1) = 0 Then
      #If ALLOW_REPETITION Then
        vA(lr) = Int((lRange - i + 1 - 1) / lMaxOccurence) + 1
      #Else
        vA(lr) = lRange - i + 1
      #End If
    Else
  #End If
      vA(lr) = vA(lRange - i + 1)
  #If LATE_INITIALISATION Then
    End If
  #End If
  i = i + 1
Next j

UniqRandInt = vR

End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbRandHistogrm (VBA)

Thu, 14 May 2026 06:46:00 +0100

Abstract

Appendix Programmcode sbRandHistogrm

Bitte den Haftungsausschluss im Impressum beachten.

Function sbRandHistogrm(dmin As Double, dMax As Double, _
            vWeight As Variant, Optional dRandom = 1#) As Double
'Specifies a histogram distribution with range dmin:dmax.
'This range is divided into vWeight.count classes. Each
'class has weight vWeight(i) reflecting the probability
'of occurrence of a value within the class.
'Similar to @Risk's function RiskHistogrm.
'Source (EN): https://www.sulprobil.de/sbrandhistogrm_en/
'Source (DE): https://www.berndplumhoff.de/sbrandhistogrm_de/
'(C) (P) by Bernd Plumhoff 18-Oct-2020 PB V1.01

Dim i As Long, n As Long, vW As Variant
Dim dRand As Double, dR As Double, dSumWeight As Double

With Application.WorksheetFunction
vW = .Transpose(.Transpose(vWeight))
End With

n = UBound(vW)
ReDim dSumWeightI(0 To n) As Double
   
dSumWeight = 0#
dSumWeightI(0) = 0#
For i = 1 To n
    If vW(i) < 0# Then 'A negative weight is an error
        sbRandHistogrm = CVErr(xlErrValue)
        Exit Function
    End If
    dSumWeight = dSumWeight + vW(i) 'Calculate sum of all weights
    dSumWeightI(i) = dSumWeight     'Calculate sum of weights till i
Next i

If dSumWeight = 0# Then  'Sum of weights has to be greater than zero
    sbRandHistogrm = CVErr(xlErrValue)
    Exit Function
End If

If dRandom = 1# Then
    dRand = Rnd()
Else
    dRand = dRandom
End If
dR = dSumWeight * dRand

i = n
Do While dR < dSumWeightI(i)
    i = i - 1
Loop

sbRandHistogrm = dmin + (dMax - dmin) * _
     (CDbl(i) + (dR - dSumWeightI(i)) / vW(i + 1)) / CDbl(n)

End Function

Bitte den Haftungsausschluss im Impressum beachten.

sbLongRandSumN (VBA)

Thu, 14 May 2026 05:46:00 +0100

Abstract

Sie benötigen 20 natürliche Zufallszahlen mit der Summe 100? Dann schlage ich meine hier gezeigte benutzerdefinierte Funktion vor. Sie können beliebig viele ganze Zahlen mit einer vorgegebenen Summe erzeugen, wobei die erzeugten Zahlen ein spezifiertes Minimum nicht unterschreiten dürfen:

Bitte beachten Sie, dass diese Funktion mit sbRandIntFixSum verwandt ist, bei der Minimum und Maximum vorgegeben werden, sowie mit der Brown’schen Brücke sbGrowthSeries, und mit sbRandSum1 welche doppelt-genaue Zahlen mit der Summe 1 erzeugt. Diese Funktion wird auch von der Anwendung sbGenerateTestData verwendet.

sbExactRandHistogrm (VBA)

Thu, 14 May 2026 04:46:00 +0100

“Chance favours the prepared mind.” [Louis Pasteur]

Abstract

Es ist recht leicht, einen “unfairen” Würfel zu simulieren. Wenn wir z. B. im Mittel die 6 doppelt so häufig wie alle anderen Zahlen 1 bis 5 erhalten wollen, geben Sie in Zelle A1 ein: =MIN(GANZZAHL(ZUFALLSZAHL()*7+1);6)

Aber wenn Sie einen Würfel 7 mal würfeln wollen und alle Zahlen von 1 bis 5 genau einmal und die 6 genau zweimal erscheinen soll?

Hier ist meine allgemeine Lösung:

sbRoundRobin (Excel / VBA)

Thu, 14 May 2026 03:33:00 +0100

Abstract

Falls Sie ein Turnier organisieren müssen, bei dem jeder einmal gegen jeden anderen Spieler spielen muss, können Sie dieses Programm verwenden. Es implementiert das sogenannte Rutschsystem:

Ein Beispiel für 6 Spieler:

Das VBA Programm - jedoch nicht der Tabellenblattfunktionsansatz - generiert auch diese Art von Paarungstabelle:

Weiterführende Literatur

Suksompong, W. (2018, April 11). Scheduling Asynchronous Round-Robin Tournaments. (Externer Link!) https://arxiv.org/pdf/1804.04504.pdf

Abel, Finizio, Greig, Lewis (2003). Generalized whist tournament designs. (Externer link!) https://www.researchgate.net/publication/222140264_Generalized_whist_tournament_designs

Cholesky (VBA)

Thu, 14 May 2026 02:46:00 +0100

Abstract

Mit der Cholesky (sprich: “Koleski”) Zerlegung können Sie einfach korrelierte Zufallszahlen erzeugen. Ich stelle hier ein einfaches Beispiel vor. Den besseren Iman Conover Ansatz finden Sie hier.

Appendix – Programmcode Cholesky und RandCorr

Bitte den Haftungsausschluss im Impressum beachten.

Function Cholesky(vA As Variant) As Variant
'I suggest to use the Cholesky decomposition just for purposes of demonstration.
'Better options are (in this order): tred2, tqli, eigsrt from Numerical Recipes.
'SVD also works but is computationally more expensive by far since it does not
'make use of symmetry.
'(Thanks to my former colleague Glen R.)
'Source (EN): https://www.sulprobil.de/cholesky_en/
'Source (DE): https://www.berndplumhoff.de/cholesky_de/
'Bernd Plumhoff 02-Nov-2024 PB V1.1
Dim d As Double
Dim i As Long, j As Long, k As Long, n As Long
With Application.WorksheetFunction
On Error Resume Next
vA = .Transpose(.Transpose(vA))
On Error GoTo 0
n = UBound(vA, 1)
If n <> UBound(vA, 2) Then
  Cholesky = CVErr(xlErrRef)
  Exit Function
End If

ReDim dR(1 To n, 1 To n) As Double 'Zeroing all elements
For j = 1 To n
  d = 0#
  For k = 1 To j - 1
    d = d + dR(j, k) * dR(j, k)
  Next k
  dR(j, j) = vA(j, j) - d
  If dR(j, j) > 0# Then
    dR(j, j) = Sqr(dR(j, j))
    For i = j + 1 To n
      d = 0#
      For k = 1 To j - 1
        d = d + dR(i, k) * dR(j, k)
      Next k
      dR(i, j) = (vA(i, j) - d) / dR(j, j)
    Next i
  Else
    'Cannot continue with usual Cholesky
    'Fill this column with zeros. Idea: Glen R.
    For i = j To n
      dR(i, j) = 0#
    Next i
  End If
Next j
Cholesky = dR
End With
End Function

Function RandCorr(n As Long, vVarCovar As Variant) As Variant
'Returns Ubound(vVarCovar,1) correlated random number vectors of length n.
'vVarCovar is a square matrix containing the variance/covariance matrix.
'Please notice that you will only get a "proxy" correlation, not an exact one.
'Bernd Plumhoff 06-Nov-2009 PB V0.2
Dim vA As Variant
Dim d As Double
Dim i As Long, j As Long, k As Long, m As Long

With Application.WorksheetFunction
vA = .Transpose(.Transpose(vVarCovar))
m = UBound(vA, 1)
If m <> UBound(vA, 2) Then
  RandCorr = CVErr(xlErrRef)
  Exit Function
End If

ReDim Db(1 To m, 1 To m) As Double
For j = 1 To m
  d = 0#
  For k = 1 To j - 1
    d = d + Db(j, k) * Db(j, k)
  Next k
  Db(j, j) = vA(j, j) - d
  If Db(j, j) <= 0 Then
    RandCorr = CVErr(xlErrNum)
    Exit Function
  End If
  Db(j, j) = Sqr(Db(j, j))
  
  For i = j + 1 To m
    d = 0#
    For k = 1 To j - 1
      d = d + Db(i, k) * Db(j, k)
    Next k
    Db(i, j) = (vA(i, j) - d) / Db(j, j)
  Next i
Next j

ReDim vR(1 To n, 1 To m) As Variant
For i = 1 To n
  For j = 1 To m
    vR(i, j) = .Norm_S_Inv(Rnd())
  Next j
Next i
vR = .MMult(vR, Db)
RandCorr = vR
End With
End Function

Downlaod

Bitte den Haftungsausschluss im Impressum beachten.

Bereichsnamen einmal anders (Excel)

Thu, 14 May 2026 02:33:00 +0100

Abstract

Normalerweise verwenden Sie Bereichsnamen in Excel, um eine hartkodierte Zuweisung zu Eingabe- oder Ausgabezellen zu vermeiden. Wenn Sie wichtigen Zellen Namen zuweisen, werden deren Bezüge bei Zeilen- oder Spalteneinfügungen oder -löschungen automatisch angepasst.

Hier wollen wir Bereichsnamen in Excel für die effiziente Implementierung einer einfachen Lösung mit verschachtelten Tabellenblattfunktionen verwenden, die nicht mehr verändert werden muss:

Für eine (fast) beliebige Anzahl von Spielern wollen wir ein einfaches Rundenturnier organisieren, bei dem jeder Spieler gegen jeden anderen genau einmal spielt. Der Einfachheit halber legen wir fest, dass Spieler 1 im ersten Spiel Heimrecht haben soll (oder anders ausgedrückt: mit Weiß spielt).

sbRandInt (VBA)

Thu, 14 May 2026 01:46:00 +0100

Abstract

Falls Sie sich nicht oder lediglich begrenzt häufig wiederholende ganzzahlige Zufallszahlen zwischen zwei gegebenen Werten benötigen, dann empfehle ich, meine benutzerdefinierte Funktion sbRandInt zu verwenden:

Appendix – Programmcode sbRandInt

Bitte den Haftungsausschluss im Impressum beachten.

Function sbRandInt(ByVal lCount As Long, _
  lMin As Long, _
  lMax As Long, _
  Optional lRept As Long = 1) As Variant
'Returns lCount random integers between lMin and lMax, each one
'occurring zero to lRept times. lMax - lMin + 1 must be greater
'or equal to lCount.
'Error values:
'#NUM!   - lRept is less than 1
'#REF!   - lCount is greater than (lMax - lMin + 1) * lRept
'#VALUE! - lCount is less than 1
'Source (EN): https://www.sulprobil.de/sbrandint_en/
'Source (DE): https://www.berndplumhoff.de/sbrandint_de/
'(C) (P) by Bernd Plumhoff  30-Dec-2024 PB V1.02
Static bRandomized As Boolean
Dim i As Long, j As Long, k As Long
Dim lRnd As Long, lRange As Long
Const CLateInitFactor = 50

If lCount < 1 Then sbRandInt = CVErr(xlErrValue): Exit Function
If lRept < 1 Then sbRandInt = CVErr(xlErrNum): Exit Function
If lCount > (lMax - lMin + 1) * lRept Then sbRandInt = CVErr(xlErrRef): Exit Function

lRange = (lMax - lMin + 1) * lRept

ReDim lr(1 To lCount) As Long

If Not bRandomized Then Randomize: bRandomized = True

ReDim lT(1 To lRange) As Long
'If we have a huge range of possible random integers and a comparably
'small number of draws, i.e. if (lMax - lMin) * lRept >> lCount
'then we can save some runtime with late initialization.
If lRange / lCount < CLateInitFactor Then
  For i = 1 To lRange
    lT(i) = Int((i - 1) / lRept) + lMin
  Next i
End If

i = 1
If lRange / lCount < CLateInitFactor Then
  For k = 1 To UBound(lr)
    lRnd = Int(((lRange - i + 1) * Rnd) + 1)
    lr(k) = lT(lRnd)
    lT(lRnd) = lT(lRange - i + 1)
    i = i + 1
  Next k
Else
  j = lMin: If lMin <= 0 And lMax >= 0 Then j = 1
  For k = 1 To UBound(lr)
    lRnd = Int(((lRange - i + 1) * Rnd) + 1)
    If lT(lRnd) = 0 Then
      lr(k) = Int((lRnd - 1) / lRept) + j
    Else
      lr(k) = lT(lRnd)
    End If
    If lT(lRange - i + 1) = 0 Then
      lT(lRnd) = Int((lRange - i) / lRept) + j
    Else
      lT(lRnd) = lT(lRange - i + 1)
    End If
    i = i + 1
  Next k
  'If lRange includes zero we need to shift result array
  If lMin <= 0 And lMax >= 0 Then
    For k = 1 To UBound(lr)
      lr(k) = lr(k) + lMin - 1
    Next k
  End If
End If

sbRandInt = lr

End Function

Bitte den Haftungsausschluss im Impressum beachten.

SystemState (VBA Class)

Wed, 13 May 2026 14:30:00 +0100

Abstract

Mein ehemaliger Kollege Jon T. entwickelte die kleinste mir bekannte sinnvolle VBA Klasse: Mit SystemState kann man Systemstatusvariablen leicht speichern und für eigene Zwecke optimieren.

Um die Programmausführung zu beschleunigen, schreibt man normalerweise zu Beginn eines VBA Makros

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

und am Ende des Makros

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Mit dem Klassenmodul SystemState schreibt man am Start lediglich

Dim state As SystemState
Set state = New SystemState
'Bitte beachten: Dies kann NICHT mit "Dim state as New SystemState" abgekürzt werden!

und am Ende

Urlaub nehmen wenn weniger los ist (Excel / VBA)

Wed, 13 May 2026 06:56:00 +0100

Abstract

Wenn Ihr Geschäft saisonal stark schwankt, können Sie den Urlaub Ihrer Belegschaft entsprechend planen und ggf. Saisonarbeitskräfte anstellen:

Hinweis: Selbstverständlich kann man keinem Mitarbeiter vorschreiben, wieviel Urlaub wann genommen werden muss. Diese Rechnungen sind lediglich Vorschläge, die als vernünftige Indikatoren dienen sollen.

Einfaches Beispiel

Wenn sie den maximalen Umsatzmonat (hier: 24.000) als Basis nehmen wollen, in dem kein Urlaub genommen werden sollte, und die restlichen Urlaubstage linear gemäß der Umsätze verteilen wollen:

Trinkgeld Verteilung (Excel)

Wed, 13 May 2026 06:50:00 +0100

“Flattery is nice but tips will suffice.”

Abstract

Sie wollen alle Trinkgelder Ihrer Mitarbeitenden fair aufteilen? Jeder soll 70% aller direkt erhaltenen Trinkgelder behalten, aber 30% sollen auf Basis gearbeiteter Stunden verteilt werden, damit auch Reinigungskräfte und Rezeptionsangestellte etwas bekommen?

Die Eingabe des Prozentsatzes, den jeder behalten kann:

Download

Bitte den Haftungsausschluss im Impressum beachten.

Trinkgeld_Verteilung.xlsx [48 KB Excel Datei, ohne jegliche Gewährleistung]

Hinweis: Eine umfassende Dokumentation meiner Excel Implementierungen finden Sie in Excel VBA Eine Sammlung.

sbDataStats (VBA)

Sun, 10 May 2026 15:44:00 +0100

“Statistics are like bikinis. What they reveal is suggestive, but what they conceal is vital.” [Aaron Levenstein]

Abstract

Selbstverständlich kann man für jede Eingabe ein spezielles Datenprüfprogramm erzeugen.

Aber was wenn Sie beliebige Daten (in einer CSV Datei) durch eine allgemeine Datenanalyse untersuchen lassen wollten?

Für eine allgemeine numerische Analyse könnten Sie einfach Minimum, Durchschnitt und Maximum ermitteln und z. B. bezüglich Extremwerten warnen, die um mehr als 2.5 Standardabweichungen vom Durchschnitt abweichen. Bei Textdaten könnte ein Analyseprogramm die Häufigkeit von Worten und Zeichen ausgeben.

Vergleiche Korrelationsmatrizen (Perl)

Sun, 10 May 2026 15:44:00 +0100

“Remember, my friend, that knowledge is stronger than memory, and we should not trust the weaker.” [Bram Stoker]

Abstract

Vor einigen Jahren entwickelte ich ein Perl Programm für einen AlgoOne Kunden. Im Laufe der Zeit erweiterte ich das Programm und ließ es die RMLinks.cfg Datei einlesen, so dass neue Risikofaktoren automatisch einbezogen wurden.

Implementierungsansatz

Mein Implementierungsansatz war:

1. Erste Matrix einlesen
    Prüfungen:
    Matrix quadratisch?
    Risikofaktorsortierung links->rechts (in der obersten Zeile) == oben->unten (in der linkesten Spalte)?
    Diagonalen == 1 (Warnung)?
    Keine NC Kategorie (Warnung falls doch)?
    Matrix symmetrisch: M(i,j) == M(j,i) für alle i,j?
    [Nicht bei DC Dateien weil dort nicht gegeben.]

2. Zweite Matrix einlesen
    Prüfungen wie oben

3. Risikofaktoren in beiden Matrizen identisch?
    Warnung bei Risikofactoren die in der ersten aber nicht in der zweiten Matrix sind und umgekehrt
    Zeige die Ausreißer pro Kategorie
    Zeige die Ausreißer pro Währung

Parameter

b - breaches: do not report differences between the two input matrices but breaches beyond tolerances.
d - debug [level] gives debugging information at detail level level
    level 1: -
    level 2: -
    level 3: Print all elements of matrices 1 and 2
f - read deviation file [-f needs to be followed by a valid filename]
    Reads min and max values for all slices for differences which should
    be ignored during comparison. See option -w to get format example
h - help: list parameters and their explanation
i -  ignore risk factors in a given file [-i needs to be followed by a valid filename]
m - set max rank index [default is 6 (=return highest 3
    and lowest 3 of each slice); m needs to be even and >= 4 !
n - tolerate risk factor category NC
r - set Algo risk factor category file [default is ./RMLinks.cfg
s - summarize findings, no detailed warnings or error messages
t - read file with tolerated changes for each matrix element and apply tolerance check
v - print version
w - write deviation file with min and max values of all slices.
    This file is comma-separated to be easily readable via Excel.
    It can be amended and used with option -f later
    [-w needs to be followed by a valid filename, preferrably ending with .csv
x - read translation table [-x needs to be followed by a valid filename].
    Risk factor names of matrix 1 will be translated by second name in comma-separated row

Beispiel für einen Programmaufruf

Ein typischer Aufruf dieses Programms von einem Shell Script aus könnte so aussehen:

Erfolgreiche Teams

Sun, 10 May 2026 13:22:00 +0100

“Teamwork is the secret that makes common people achieve uncommon results.” [Ifeanyi Onuoha]

Übersicht

In homogenen Teams haben die Mitglieder ähnliche Persönlichkeiten und Stärken. Es gibt wenig Konflikte, aber die Ergebnisse sind oft nicht optimal. Je breiter die Rollen im Team gestreut sind, desto leistungsfähiger ist das Team. Wenn sich die Mitglieder dieser Verteilung bewusst sind, verbessert dies die Ergebnisse weiter. Für die erfolgreiche Zusammensetzung von Arbeitsgruppen existieren viele verschiedene Ansätze.

Adonis (BPM)

Wed, 06 May 2026 06:25:00 +0100

“Lack of documentation is becoming a problem for acceptance.” [Wietse Venema]

Abstract

Adonis ist eine Geschäfts-Prozessmanagement Anwendung. Sie wurde 1995 an der Universität Wien entwickelt. Adonis kann die Dokumentation, Analyse und Optimierung von Geschäftsprozessen unterstützen.

Zugang und Verwendung

Unternehmen können eine reguläre (externer Link!) Adonis Lizenz erwerben. Privatpersonen können die kostenlose (externer Link!) Adonis:CE Anwendung nutzen.

(Externer Link!) Adonis User Manual ist ein detailliertes online Benutzerhandbuch.

Beschränkungen der kostenlosen Adonis:CE

Nach 60 Tagen ohne Login wird ein Adonis:CE Account deaktiviert.

Schule des Denkens

Fri, 10 Apr 2026 13:11:00 +0100

“If there is a problem you can’t solve, then there is an easier problem you can solve: find it.” [George Pólya]

Abstract

Jeder, der Probleme strukturiert lösen möchte, sollte zunächst “Schule des Denkens” von George Pólya lesen.

Auch wenn Pólya hauptsächlich mathematische Probleme im Auge hatte, kann man seine Techniken allgemein anwenden.

Pólya’s Prinzipen

In seinem Buch unterscheidet Pólya 4 einfache Phasen des Problemlösens.

Wir wollen diese Phasen anhand einer Beispielaufgabe erläutern:

Mitarbeiter Umsatzanteile (Excel / VBA)

Wed, 08 Apr 2026 05:18:00 +0100

Abstract

Diese Anwendung ist ein Umsatzbericht. Er verwendet meine bevorzugten Programmelemente.

Eingabe:

Ausgabe:

So erkennen Sie Ihre wichtigsten Kunden und Mitarbeiter auf einen Blick (siehe grüner Hintergrund):

Mit den Kunden GHI GmbH & Co KG und DEF AG erzielen Sie mehr als 50% Ihres Gesamtumsatzes.
Ihre Mitarbeiter MA2 und MA1 generieren mehr als 50% Ihres Gesamtumsatzes.

Das Ziel war ein einfacher, nachvollziehbarer Berichtsprozess: Welche Mitarbeiter hatten welche Umsatzanteile für welchen Mandanten, und wer hat wann welchen Umsatzbericht mit welchem Ergebnis erstellt.
Die Scripting Dictionaries oMA, oMASumme, oMandant, oMandantSumme und oSumme ermöglichen die einfache Sammlung, Speicherung und Ausgabe von allen numerischen und nicht-numerischen Daten mit nicht-numerischen Suchbegriffen.
Die Ausgabedaten werden sowohl im Tabellenblatt Output als auch im Unterverzeichnis Reports ausgegeben und durch die Subroutine sbZip zusätzlich in ein Jahresarchiv gezippt.
Die Funktion RoundToSum stellt die fehlerfreie Rundung der Mitarbeiteranteile sicher.
Die Enumerierung Eingabespalten ermöglicht eine nachvollziehbare Adressierung und einfache spätere Änderung der Eingabespalten.
Das Modul modLog und das Klassenmodul clsLog zeigen, wer welchen Umsatzbericht wann mit welchem Ergebnis erstellt hat. Siehe Tabellenblatt Workflow und Unterverzeichnis Logs.
Das Klassenmodul SystemState stellt die gewünschten Umgebungsparameter für die Anwendung ein und setzt sie nach Programmende zurück.
Die Anwendung adressiert die Tabellenblätter direkt mit VBA internen Codenamen (wsI, wsO, wsW).
Fehlerhafte Eingaben und inkonsistente Ausgabesummen werden farblich (in gelb) markiert und in den Logs protokolliert.
Das Modul (externer Link!) LibFileTools stellt sicher, dass diese Anwendung auch unter Sharepoint / OneDrive läuft.
Das Modul (externer Link!) TimeZone bietet die Umrechnungen von Zeitzonen - Voraussetzung ist ein ordnungsgemäß installiertes MS Outlook.
Die Module (externe Links!) modPerf und modTimer und das Klassenmodul clsPerf ermöglichen die Messung der Laufzeiten von Subroutinen und Funktionen - dafür muss die Precompilerkonstante MEASURE_RUNTIME = True gesetzt werden.
Falls eine andere Anwendung die Eingabedaten (z. B. Umsätze pro Mandant, Zeiterfassungen der Mitarbeiter multipliziert mit deren Seniorität als Gewichte) als Datei bereitstellen kann, sollte diese Anwendung um ein Unterverzeichnis Eingabedateien mit Jahresunterordner (analog der existierenden Ausgabestruktur) erweitert werden.
Eine detaillierte Dokumentation dieser Anwendung ist mit dem BPM System Adonis einfach möglich.

Download

Bitte den Haftungsausschluss im Impressum beachten.

Excel Funktionen (Excel / VBA)

Sat, 27 Sep 2025 15:58:00 +0100

Bitte beachten Sie, dass alle Links unter den Funktionsnamen und -typen (bei VBA Funktionen und Anweisungen) externe Links sind, die auf Microsoft Hilfeseiten verweisen.

Die Spalte In VBA mit Application.WorksheetFunction nennt den englischen Funktionsnamen, mit dem Sie diese Funktionen in VBA mit Application.WorksheetFunction.<FunctionName> aufrufen können.

Für neuere Funktionen sehen Sie unter Eingeführt, ab welcher Excel Version sie verfügbar sind.

Die Operatoren am Anfang der Liste sind nicht alphabetisch, sondern nach Präzedenz (Vorrang, Priorität) geordnet: -2^2 ergibt z. B. 4 und nicht etwa -4, weil das unäre Minus Vorrang vor der Potenzierung hat, aber -(2^2) = -4 weil die Klammern die Berechnungsreihenfolge ändern.

Arbeitskompetenzen

Sat, 27 Sep 2025 15:54:00 +0100

“Für das Können gibt es nur einen Beweis: das Tun.” [Marie von Ebner-Eschenbach]

Abstract

Sie möchten Ihre:n Vorgesetzte:n von Ihrer ausgezeichneten Arbeit überzeugen? Oder Sie als Vorgesetzte:r wollen Ihre Mitarbeiter:innen hinsichtlich ihrer Stärken in verschiedene Teams aufteilen?

Das englischsprachige Buch “Competence at Work” von Lyle M. Spencer und Signe M. Spencer kann hier helfen: Dieses Buch zielte in erster Linie darauf ab, Unternehmen und Personalabteilungen die erfolgreiche Auswahl von Mitarbeitenden zu erleichtern. Für verschiedene Tätigkeitsprofile werden notwendige Kompetenzen mit Skalenwerten vorgestellt.

Risikobewertung

Sat, 27 Sep 2025 15:52:00 +0100

“Knowledge is the only instrument of production that is not subject to diminishing returns.” [John Clarke]

Zusammenfassung

Diese Übung stammt von Nidal Sh., einem ehemaligen Kollegen von mir. Ich denke, es ist eine äußerst hilfreiche Übung, um das Verständnis für Daten und Risiko im Allgemeinen zu schärfen.

Szenario:

Du bist ein Fondsmanager (Devisen, Immobilien, Aktien oder festverzinsliche Wertpapiere). Du musst zwei Präsentationen vorbereiten:

a) Überzeuge deinen CEO davon, dass dein Fonds im Vergleich zu den anderen sehr risikobehaftet ist. Du brauchst mehr Kapital, Budget und andere Ressourcen, um angemessen damit umzugehen.

Mitarbeiter Aufgaben Matrix

Sat, 27 Sep 2025 15:51:00 +0100

Abstract

Falls Sie ein Team leiten:

Priorisieren Sie jede Aufgabe und weisen Sie ihr einen Wert zu, basierend auf dem erforderlichen Wissen, Denken und Verantwortung, die mit ihr verbunden sind.

Für jede Aufgabe muss ein/e verantwortliche/r Mitarbeiter:in definiert werden. Geben Sie die Zahl 2 in die entsprechende Zeile und Spalte ein. Bei normalem laufenden Geschäft legen Sie auch eine Vertretung fest. Für Vertreter:innen wird eine 1 eingetragen. Vertretungen können entfallen für Projektaufgaben oder Aufgaben, die selten ausgeführt werden.

Projektmanagement (PRINCE2)

Sat, 27 Sep 2025 15:50:00 +0100

“Assumption is the mother of all f***-ups.” [Everett McGill when playing Marcus Penn]

Abstract

Projektmanagement besteht im Organisieren und Managen von Ressourcen damit ein Projekt im geplanten Rahmen von Kosten, Qualität, Umfang und Zeiten fertiggestellt werden kann. Ein Projekt ist zeitlich befristet und eine Einmalaufgabe, um ein Produkt zu erstellen oder einen Service einzurichten, der eine gewünschte Änderung herbeiführt oder einen zusätzlichen Nutzen darstellt.

Die verantwortliche Person, die ein Projekt organisiert und steuert, wird Projektmanager genannt. Es gibt einige Organisationen, die notwendige und sinnvolle Projektmanagement-Fähigkeiten trainieren. Zum Beispiel für PRINCE2 (externer Link!):

Buchlederpflege

Sat, 27 Sep 2025 15:47:00 +0100

“A truly great book should be read in youth, again in maturity and once more in old age.” [Robertson Davies]

Disclaimer

Alle Angaben ohne Gewähr. Bitte den Haftungsausschluss im Impressum beachten.

Abstract

Buchleder ist empfindlich. Wenn es nicht gepflegt wird, trocknet es aus, wird spröde und reißt. Alle 4 Jahre sollte es mit einem geeigneten Buchleder-Pflegemittel eingerieben werden. Das hier vorgestellte Rezept können Sie in jeder Apotheke herstellen lassen. Es stammt von einem Bibliothar einer Göttinger Bibliothek.

Stromtankstellen

Mon, 21 Feb 2022 07:09:00 +0100

Abstract

Laut Hannoverscher Allgemeine Zeitung am 21.02.2022 sei EnBW-Chef Frank Mastiaux der Ansicht, dass 130.000 bis 150.000 Hochgeschwindigkeitsladepunkte für 15 Millionen E-Fahrzeuge reichen würden. Die Autoindustrie fordere hingegen bis 2030 eine Million Ladeplätze.

Im Oktober 2021 waren etwas über 500.000 Elektroautos in Deutschland zugelassen.

Anfang November 2021 wies die Bundesnetzagentur für Deutschland 41.993 Normal- und 7.214 Schnellladepunkte aus, die öffentlich zugänglich sind. Das entspricht etwa 1,7 Ladepunkten pro 1.000 Einwohnern.