Formel aufteilen und summieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Dim a As String Dim plus As Long Dim minus As Long Dim i As Long a = Replace(Cells(1, 1).Formula, "=", "+") For i = Len(a) To 1 Step -1 If Mid(a, i, 1) = "+" Then plus = plus + CLng(Mid(a, i, 9 ^ 9)) a = Left(a, i - 1) ElseIf Mid(a, i, 1) = "-" Then minus = minus + CLng(Mid(a, i, 9 ^ 9)) a = Left(a, i - 1) End If Next MsgBox plus 'Summe Pluszahlen MsgBox minus 'Summe Minuszahlen MsgBox plus + minus 'Ergebniss


Sub Formel_zerlegen()
Dim tmp, posz(), negz() As Variant
Dim ii, ipos, ineg  As Integer
Dim tmpint As Double
Dim spos As Double
Dim sneg As Double
ipos = 1
ineg = 1
tmp = Split(Replace(Cells(1, 1).Formula, "=", "+"), "+")
For ii = 1 To UBound(tmp)
npruef:
If InStr(tmp(ii), "-") > 0 Then
'negative Zahl enthalten
ReDim Preserve negz(ineg)
negz(ineg) = Right(tmp(ii), (Len(tmp(ii)) - InStrRev(tmp(ii), "-")))
tmp(ii) = Left(tmp(ii), InStrRev(tmp(ii), "-") - 1)
ineg = ineg + 1
GoTo npruef
Else
'positive Zahl
ReDim Preserve posz(ipos)
posz(ipos) = tmp(ii)
ipos = ipos + 1
End If
Next ii
For ii = 1 To UBound(posz)
spos = spos + posz(ii)
Next ii
For ii = 1 To UBound(negz)
sneg = sneg + negz(ii)
Next ii
MsgBox "Dies Summe aller positiven Zahlen ist " & spos & vbCrLf & _
"Es waren " & UBound(posz) & " Positive Zahlen" & vbCrLf & _
"Der Mittelwert aller Positiven Zahlen ist " & spos / UBound(posz) & vbCrLf & vbCrLf & _
"Dies Summe aller negativen Zahlen ist " & sneg & vbCrLf & _
"Es waren " & UBound(negz) & " Positive Zahlen" & vbCrLf & _
"Der Mittelwert aller Positiven Zahlen ist " & sneg / UBound(negz)
End Sub

Gruß
Dirk

Function PlusMinus(rng As Range) Dim Plus As Single, Minus As Single Dim arr1, arr2 Dim i As Integer, j As Integer arr1 = Split(Mid(rng.FormulaLocal, 2), "-") For i = 0 To UBound(arr1) arr2 = Split(arr1(i), "+") If UBound(arr2) > -1 Then Minus = Minus + arr2(0) For j = 1 To UBound(arr2) Plus = Plus + arr2(j) Next End If Next If arr1(0) "" Then 'der erste Wert ist positiv Minus = Minus - Split(arr1(0), "+")(0) Plus = Plus + Split(arr1(0), "+")(0) End If PlusMinus = Array(Plus, -Minus) End Function

Option Explicit Function SummeSpezial(myRange, Operator As String) Dim Regex As Object Dim Werte$ Werte = myRange.FormulaLocal Set Regex = CreateObject("VBscript.regexp") With Regex .Global = True .Pattern = "(-\d+)|(\+?\d+)" Select Case Operator Case "-": SummeSpezial = Evaluate(.Replace(Werte, "$1")) Case "+": SummeSpezial = Evaluate(.Replace(Werte, "$2")) Case "-+", "+-": SummeSpezial = Evaluate(.Replace(Werte, "$2")) + Evaluate(.Replace( _ Werte, "$1")) End Select End With End Function

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread