Thema Datum  Von Nutzer Rating
Antwort
13.05.2014 17:08:59 Gast9241
Solved
13.05.2014 17:44:57 Gast27593
NotSolved
14.05.2014 11:06:34 Gast44320
NotSolved
14.05.2014 12:24:48 Gast97928
NotSolved
14.05.2014 14:55:54 Gast60942
NotSolved
14.05.2014 15:49:22 Gast51899
NotSolved
17.05.2014 09:53:22 Gast29035
NotSolved
17.05.2014 11:49:38 Gast82195
NotSolved
17.05.2014 20:38:42 Gast96071
NotSolved
20.05.2014 18:34:06 Gast8649
NotSolved
20.05.2014 21:41:59 Gast12012
NotSolved
20.05.2014 22:27:03 Gast97120
NotSolved
Rot Gleitender Durchschnitt
21.05.2014 00:38:42 Gast88349
NotSolved
21.05.2014 00:39:11 Gast21760
NotSolved
21.05.2014 08:57:32 Gast5621
NotSolved
21.05.2014 10:10:56 Gast3523
NotSolved
21.05.2014 16:13:44 Gast27780
NotSolved
21.05.2014 16:22:50 Gast65966
NotSolved
21.05.2014 17:04:46 Gast92787
NotSolved
21.05.2014 20:10:03 Gast75535
NotSolved
22.05.2014 14:49:31 Gast60006
NotSolved
14.05.2014 11:06:54 Gast60815
NotSolved
14.05.2014 11:06:54 Gast91131
NotSolved
14.05.2014 11:06:55 Gast53841
NotSolved

Ansicht des Beitrags:
Von:
Gast88349
Datum:
21.05.2014 00:38:42
Views:
1058
Rating: Antwort:
  Ja
Thema:
Gleitender Durchschnitt

*seufz*

Hier sind die Varianten für Matrix und Vektor.

Der Funktion SMA kannst du nun entweder die Daten direkt vom Tabellenblatt übergeben, oder du übergibst hier selbst ein Array.

 

PS: Möglich das es noch kleinere Fehler beinhaltet. Hab es nicht auf Herz und Nieren geprüft.

 

Option Explicit

Sub Test01()
  
  With Range("A1:A12000")
    .Formula = "=RANDBETWEEN(100,1000)"
    .Value = .Value
    'Ergebnis in der Spalte daneben hinschreiben
    .Offset(ColumnOffset:=1).NumberFormat = "0.000"
    .Offset(ColumnOffset:=1).Value = SMA(.Cells, 5)
  End With
  
End Sub

Sub Test02()
  
  Dim v As Variant
  Dim r As Variant
  Dim i As Long
  Dim s As String
  
  v = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
  r = SMA(v, 2)
  
  'Ausgabe für VBA Direktfenster vorbereiten
  For i = LBound(r) To UBound(r)
    
    If s <> "" Then s = s & "; "
    
    If Not IsError(r(i)) Then
      s = s & Format$(r(i), "0.00")
    Else
      Select Case CLng(r(i))
        Case XlCVError.xlErrRef
          s = s & "#REF"
        Case XlCVError.xlErrValue
          s = s & "#VAL"
        Case XlCVError.xlErrNum
          s = s & "#NUM"
        Case XlCVError.xlErrNA
          s = s & "#NA"
        Case Else
          s = s & "#ERR(" & CLng(r(i)) & ")"
      End Select
    End If
    
  Next
  
  'Ausgabe
  Debug.Print "{" & s & "}"
  
End Sub

'////////////////////////////////////////////////////////////////
'// simple moving average
Public Function SMA(Expression As Variant, Interval As Long) As Variant
  
  Dim expr As Variant
  Dim blnTranspose As Boolean
  
  On Error GoTo ErrInvalidExpr
  
  If IsArray(Expression) Then
    expr = Expression
  Else
    GoTo ErrInvalidExpr
  End If
  
  Select Case GetArrayDim(expr)
    Case 1: SMA = SMA_V(expr, Interval)
    Case 2: SMA = SMA_M(expr, Interval)
    Case Else: GoTo ErrInvalidExpr
  End Select
  
SafeExit:
  If IsArray(expr) _
    Then Erase expr
  
Exit Function

ErrInvalidExpr:
  SMA = CVErr(XlCVError.xlErrRef)
  GoTo SafeExit
End Function

'////////////////////////////////////////////////////////////////
'// simple moving average (matrix version)
Private Function SMA_M(Matrix As Variant, ByVal Interval As Long) As Variant
  
  If GetArrayDim(Matrix) <> 2 _
    Then GoTo ErrInvalidMatrix
  
  Dim avntSMA As Variant
  Dim dblSum  As Double
  Dim m As Long, n As Long
  Dim i As Long, j As Long
  
  m = UBound(Matrix) - LBound(Matrix) + 1
  n = UBound(Matrix, 2) - LBound(Matrix, 2) + 1
  
  If m > 1 Eqv n > 1 Then
  'only one direction allowed
    GoTo ErrInvalidMatrix
  ElseIf Not (2 <= Interval And Interval <= m * n) Then
  'interval out of range
    SMA_M = CVErr(XlCVError.xlErrNum)
    Exit Function
  End If
  
  If m > n Then
    Interval = Interval + LBound(Matrix, 1) - 1
  Else
    Interval = Interval + LBound(Matrix, 2) - 1
  End If
  
  ReDim avntSMA(LBound(Matrix) To UBound(Matrix), LBound(Matrix, 2) To UBound(Matrix, 2))
  
  On Error GoTo ErrNotNumeric
  
  i = LBound(Matrix)
  j = LBound(Matrix, 2)
  
  Do Until i > UBound(Matrix) _
        Or j > UBound(Matrix, 2)
    
    dblSum = dblSum + CDbl(Matrix(i, j))
    
    If m > n Then
      If i >= Interval Then
        avntSMA(i, j) = dblSum / CDbl(Interval)
        dblSum = dblSum - CDbl(Matrix(LBound(Matrix) + i - Interval, j))
      Else
        avntSMA(i, j) = CVErr(XlCVError.xlErrNA)
      End If
      i = i + 1
    Else
      If j >= Interval Then
        avntSMA(i, j) = dblSum / CDbl(Interval)
        dblSum = dblSum - CDbl(Matrix(i, LBound(Matrix, 2) + j - Interval))
      Else
        avntSMA(i, j) = CVErr(XlCVError.xlErrNA)
      End If
      j = j + 1
    End If
    
  Loop
  
SafeExit:
  SMA_M = avntSMA
  Erase avntSMA
  
Exit Function

ErrInvalidMatrix:
  SMA_M = CVErr(XlCVError.xlErrRef)
  Exit Function
  
ErrNotNumeric:
  Do Until i > UBound(Matrix) _
        Or j > UBound(Matrix, 2)
    avntSMA(i, j) = CVErr(XlCVError.xlErrValue)
    If m > n Then
      i = i + 1
    Else
      j = j + 1
    End If
  Loop
  GoTo SafeExit
End Function

'////////////////////////////////////////////////////////////////
'// simple moving average (vector version)
Private Function SMA_V(Vector As Variant, ByVal Interval As Long) As Variant
  
  If GetArrayDim(Vector) <> 1 _
    Then GoTo ErrInvalidVector
  
  Dim avntSMA() As Variant
  Dim dblSum  As Double
  Dim i As Long
  
  If Not (2 <= Interval And Interval <= (UBound(Vector) - LBound(Vector) + 1)) Then
  'interval out of range
    SMA_V = CVErr(XlCVError.xlErrNum)
    Exit Function
  End If
  
  Interval = Interval + LBound(Vector) - 1
  
  ReDim avntSMA(LBound(Vector) To UBound(Vector))
  
  On Error GoTo ErrNotNumeric
  
  For i = LBound(Vector) To UBound(Vector)
    dblSum = dblSum + CDbl(Vector(i))
    If i >= Interval Then
      avntSMA(i) = dblSum / CDbl(Interval)
      dblSum = dblSum - CDbl(Vector(i - Interval))
    Else
      avntSMA(i) = CVErr(XlCVError.xlErrNA)
    End If
  Next
  
SafeExit:
  SMA_V = avntSMA
  Erase avntSMA
  
Exit Function

ErrInvalidVector:
  SMA_V = CVErr(XlCVError.xlErrRef)
  Exit Function
  
ErrNotNumeric:
  For i = i To UBound(Vector)
    avntSMA(i) = CVErr(XlCVError.xlErrValue)
  Next
  GoTo SafeExit
End Function

'////////////////////////////////////////////////////////////////
'// determine max array dimension
Private Function GetArrayDim(VarName As Variant) As Long
  Dim t As Long
  On Error Resume Next
  Do
    GetArrayDim = GetArrayDim + 1
    t = UBound(VarName, GetArrayDim)
  Loop While Err.Number = 0
  GetArrayDim = GetArrayDim - 1
End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
13.05.2014 17:08:59 Gast9241
Solved
13.05.2014 17:44:57 Gast27593
NotSolved
14.05.2014 11:06:34 Gast44320
NotSolved
14.05.2014 12:24:48 Gast97928
NotSolved
14.05.2014 14:55:54 Gast60942
NotSolved
14.05.2014 15:49:22 Gast51899
NotSolved
17.05.2014 09:53:22 Gast29035
NotSolved
17.05.2014 11:49:38 Gast82195
NotSolved
17.05.2014 20:38:42 Gast96071
NotSolved
20.05.2014 18:34:06 Gast8649
NotSolved
20.05.2014 21:41:59 Gast12012
NotSolved
20.05.2014 22:27:03 Gast97120
NotSolved
Rot Gleitender Durchschnitt
21.05.2014 00:38:42 Gast88349
NotSolved
21.05.2014 00:39:11 Gast21760
NotSolved
21.05.2014 08:57:32 Gast5621
NotSolved
21.05.2014 10:10:56 Gast3523
NotSolved
21.05.2014 16:13:44 Gast27780
NotSolved
21.05.2014 16:22:50 Gast65966
NotSolved
21.05.2014 17:04:46 Gast92787
NotSolved
21.05.2014 20:10:03 Gast75535
NotSolved
22.05.2014 14:49:31 Gast60006
NotSolved
14.05.2014 11:06:54 Gast60815
NotSolved
14.05.2014 11:06:54 Gast91131
NotSolved
14.05.2014 11:06:55 Gast53841
NotSolved