Option Explicit
Sub Geomittel()
Const m_ModName As String = "Stefanie"
Const m_PrcName As String = "Geomittel"
Const sErsteZelle As String = "A2"
Const lBereich As Long = 3
Const lRechts As Long = 1
Dim rngZinsen As Range
Dim lngOffset As Long
On Error GoTo Geomittel_Error
lngOffset = lBereich - 1
Set rngZinsen = Range(Range(sErsteZelle), _
Range(sErsteZelle).Offset(lngOffset))
Do
If WorksheetFunction.CountBlank(rngZinsen) > 0 Then Exit Do
rngZinsen.Cells(lBereich).Offset(0, lRechts).FormulaR1C1 = "=GEOMEAN(R[-2]C[-1]:RC[-1])"
Set rngZinsen = rngZinsen.Offset(lBereich)
Loop
On Error GoTo 0
Geomittel_Error:
Select Case Err.Number
Case Is = 0:
Case Else:
Select Case Errormessage(Application.VBE.ActiveCodePane.CodeModule & _
" < Module / ProCedure > " & m_ModName & " / " & m_PrcName)
Case Is = vbAbort:
Application.SendKeys Keys:="{F8}" & "{F8}", Wait:=False
Stop: Resume
Case Is = vbRetry:
Resume
Case Is = vbIgnore:
End Select
End Select
End Sub
Private Function Errormessage(myMacro As String) As Long
Const DebugMode = True
Errormessage = MsgBox("Error#" & Err.Number & vbCrLf & Err.Description, _
IIf(DebugMode, vbAbortRetryIgnore, vbCritical) + vbMsgBoxHelpButton, _
myMacro, Err.HelpFile, Err.HelpContext)
End Function