Hmm...............................

beim Testen mit "echten" Zinsen fallen mir Rundungsdifferenzen bei der Anwendung der Excel-Funktion GEOMITTEL auf,

hier noch eine Alternative

Option Explicit

Sub BetterGeomittel()
'---------------------------------------------------------------------------------------
' Project   : VBAProject
' Module    : Modul
' Procedure : Sub
' Author    : Hmm
' Date      : 02.06.2014
' Time      : 20:57
' Purpose   : VBA-Forum
'---------------------------------------------------------------------------------------
'
Const m_ModName As String = "Modul1"
Const m_PrcName As String = "BetterGeomittel"
'
'
Const sErsteZelle As String = "A2"              'Zelle mit "erstem" Zins
Const lBereich As Long = 12                      'jeweils zusammengefasst
Const lRechts As Long = 2                       'Ergbnis um lRechts versetzt
'
Dim rngZinsen As Range                          'Spaltenbereich Zinsen
Dim lngOffset As Long                           'ditto

  On Error GoTo Geomittel_Error

  lngOffset = lBereich - 1                      'immer dazunehmen
  
  Set rngZinsen = Range(Range(sErsteZelle), _
      Range(sErsteZelle).Offset(lngOffset))     '1. Block Größe lBereich
  
  Do
  
    'Abbruch
    If WorksheetFunction.CountBlank(rngZinsen) > 0 Then Exit Do
    
    'Aktion
    rngZinsen.Cells(lBereich).Offset(0, lRechts).FormulaR1C1 = fncAccuracy(rngZinsen, 1)
    
    'erhöhen
    Set rngZinsen = rngZinsen.Offset(lBereich)
    
  Loop

  On Error GoTo 0
'
'---------------------------------------------------------------------------------------
Geomittel_Error:
'
Select Case Err.Number
  Case Is = 0: 'errorless
  ' Case is = #: 'custom
  Case Else: 'display
    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: 'User canceled
    End Select
  End Select
'
'---------------------------------------------------------------------------------------
'
End Sub
'
Function fncAccuracy(calcR As Range, dFact As Double) As Double
Dim dblProduct As Double
Dim c As Range
  dblProduct = 1

  For Each c In calcR.Cells
    dblProduct = dblProduct * (dFact + c.Value)
  Next c

  fncAccuracy = -dFact + dblProduct ^ (dFact / calcR.Count)

End Function
'
'---------------------------------------------------------------------------------------
Private Function Errormessage(myMacro As String) As Long
' vbAbort: Stop: Resume
' vbRetry: Resume
' vbIgnore: User canceled
Const DebugMode = True 'False 'True = debugging
  Errormessage = MsgBox("Error#" & Err.Number & vbCrLf & Err.Description, _
  IIf(DebugMode, vbAbortRetryIgnore, vbCritical) + vbMsgBoxHelpButton, _
myMacro, Err.HelpFile, Err.HelpContext)
End Function
'
'---------------------------------------------------------------------------------------