E L E F A N T A S T I S C H    ! ! !

(Husten – wir haben ein Problem)

als du eingangs deine Frage sooo schön abstrakt formuliert hast, dachte ich nicht im Traum daran, DASS

wir mit dem Algorithmus "Zahlen so lange summieren, bis die neue Zahl die hinzukommt, das Ergebnis verdoppelt" in einer "quasi" kfm. Tabelle ankommen

(eher an ein Zahlenrätsel :-O).

Alles mündet in der Aufgabe  eine gebildete Summe mit einem Wert zu vergleichen und ausgerechnet fast auf Anhieb hattu die Schwachstelle erwischt.

(oTon Microsoft "Diese kleine Abweichung bei der Darstellung von 0,0001 im Binärsystem kann bei Additionen einen erheblichen Einfluss auf die Gesamtsumme haben. Aus demselben Grund sollten Sie bei Vergleichen reeller Zahlen immer sehr vorsichtig sein. ")

Mein Demo - Code dazu unten :

Was tun sprach Zeus, wenn schon die "Götter" besoffen. Irgendwie müssen wir die Aufgabe "anders" bewältigen, daher :

Wie kommen die EURonen in die Tabelle (zu Fuß per Handzeichen oder aus einem anderen Programm / Makro) ?

Sind die Beträge aus irgendwelchen Formeln abgeleitet ?

Sind die Zellen formatiert ? - (was ja keinen Einfluss auf deren Wert), nur habe ich festgestellt, dass z.B. diverses Kopieren jeden Code plötzlich die Bedingung als "erfüllt" vermittelt.

Toleranzen in Bruchteilen von Cent zu erlauben wäre vielleicht eine Methode, nur möchte ich da erst das endgültige "Produkt" kennen !

Option Explicit

Sub perPedes()
Dim x As Long
Dim Ad As Double

With Range(Cells(5, 1), Cells(15, 1))
  .Clear
  .NumberFormat = "General"
End With
'Zahlenreihe wie von Tanja vorgegeben erzeugen
Cells(5, 1).Value = 802.4
Cells(7, 1).Value = 468
Cells(9, 1).Value = 2230
Cells(11, 1).Value = 1969.82
Cells(13, 1).Value = 106.56
Cells(14, 1).Value = 338

Cells(15, 1).Value = 5914.78
'Auswerten durch schlichtes Zusammenzählen
For x = 5 To 15
  If Cells(x, 1).Value = Ad Then
    MsgBox Cells(x, 1).Address
  Else
  Ad = Ad + Cells(x, 1).Value
  End If
Next x
End Sub

Sub Dagegen()
Dim x As Long
Dim Ad As Double
Dim Wert As Double
With Range(Cells(5, 1), Cells(15, 1))
  .Clear
  .NumberFormat = "General"
End With
'Zahlenreihe gering verändert
Wert = 802.4
Cells(5, 1).Value = 802.4
Cells(7, 1).Value = 468
Cells(9, 1).Value = 2230
Cells(11, 1).Value = 1969.82
Cells(13, 1).Value = 106
Cells(14, 1).Value = 338.33

Cells(15, 1).Value = 5914.55

'Auswerten wie vor
For x = 5 To 15
  If Cells(x, 1).Value = Ad Then
    MsgBox Cells(x, 1).Address
  Else
  Ad = Ad + Cells(x, 1).Value
  End If
Next x
End Sub

Sub Microsoft()
'oTon aus KB D44053, hier wird das Problem so beschrieben
'Nehmen wir das folgende einfache Beispiel
Dim i, sum, item1, item2
 sum = 0
   For i = 1 To 10000
      sum = sum + 0.0001
   Next i
   MsgBox sum                   ' Theoretisch = 1,0.
  'oder
  item1 = 69.82
   item2 = 69.2 + 0.62          'sollte 69,82 ! sein
   If item1 = item2 Then
    MsgBox "Equality!"
   Else
    MsgBox "Sch................!"
   End If
End Sub