Servus Tanja,

ich wiederhole zum Vergleich

Text Einkaufswert 

Text  (EUR)

Text ProjektHK

Leer

Leer               

Zahl 802,4

Leer               

Zahl 468

Leer               

Zahl 2.230,00

Leer               

Zahl 1.969,82

Leer               

Zahl 106,56

Leer               

Zahl 338

Leer               

Leer                

Leer                               

Leer                               

Zahl 5.914,78

Leer                               

Zahl 0

Leer                               

Zahl 0

läuft bei mir super – AUF EINEM LEEREN TABELLENBLATT eingegeben, d.h. keine Zellen sind "verschmutzt"

fällt auf die Schnauze, sobald eine scheinbar leere Zelle irgendein "unsichtbares" Zeichen enthält, wo nicht dargestellt wird.

Anbei Workaround Nr. 2 in Bezug auf Leerzeichen chr(32) in "leeren Zellen".

< Also die Zahlen kommen aus BaaN (Warenwirtschaftssystem, sind  ..............

Das System ist schon ein wenig in die Jahre – oder ?

Nochmals die Frage, wer, wie erzeugt die Daten im Excel-Tabellenblatt ?

Existiert da eine Schnittstelle (Funktion vom BaaN) mit einer Datendatei oder erzeugt BaaN so eine Tabelle. Oder kloppt wer die Daten zu Fuß !?!

Ich höre – Gruß gabi

Option Explicit

Sub NewInBlöcken()
Const tbStart As String = "A1"
Const intbSpalte As String = "B"
 
'für die Zeilen in tbStart-Spalte
Dim lngLetzte As Long 'letzte Zeile
Dim x As Long  'Schleife über tbStart-Spalte
Dim lngtbSpalte As Long 'Spaltennummer
Dim rngLetzte As Range  'letzte Zelle der Spalte
 
'hier wird der Code "Verdoppelt" gebraucht
Dim AbZelle As String
Dim NachSpalte As String
 
'letzte Zeile in "der" Spalte und dort die letzte Zelle
lngLetzte = Columns(Range(tbStart).Column).Find("*", Range(tbStart), _
  searchOrder:=xlByRows, searchdirection:=xlPrevious).Row
lngtbSpalte = Range(tbStart).Column
Set rngLetzte = Cells(lngLetzte, lngtbSpalte)
 
'durchlaufe "die" Spalte
For x = 1 To lngLetzte
  'prüfe auf kein Zahlenwert und nicht leer
  Cells(x, lngtbSpalte).Value = Trim(Cells(x, lngtbSpalte).Value)
  On Error Resume Next
  Cells(x, lngtbSpalte).Value = CDbl(Cells(x, lngtbSpalte).Value)
  On Error GoTo 0
  If Cells(x, lngtbSpalte).Formula = "0" Then Cells(x, lngtbSpalte).Formula = ""
  If IsNumeric(Cells(x, lngtbSpalte).Value) And _
      Cells(x, lngtbSpalte).Value <> "" Then
       
    AbZelle = Cells(x, lngtbSpalte).Address 'ab hier
    NachSpalte = intbSpalte 'dorthin schreiben
    BerVerdoppelt AbZelle, NachSpalte, rngLetzte  'Aufrufen und Startwerte übergeben
  End If
Next x
 
'
End Sub
  
Sub BerVerdoppelt(ByVal Start As String, ByVal inSpalte As String, _
  ByVal rngEnde As Range)
'die Startwerte wurden übergeben
Dim rngStart As Range
Dim rngSpalte As Range
Dim rngIst As Range
Dim lngNext As Long
Dim dblWsF  As Double, dblIst As Double
 
On Error GoTo errorhandler  'Fehler tritt ein wenn nicht rechenbar
 
  Set rngStart = Range(Start) 'Beginn
  Set rngSpalte = Range(rngStart.Offset(1, 0), rngEnde) 'Bereich ab Zelle darunter
  lngNext = Columns(inSpalte).Column - rngStart.Column 'im Abstand daneben schreiben
    
  For Each rngIst In rngSpalte  'durchlaufen
  ' so lange summieren, bis die neue Zahl die hinzukommt, das Ergebnis verdoppelt
    dblWsF = WorksheetFunction.sum(Range(rngStart, rngIst))
    dblIst = rngIst.Value + rngIst.Value
     
    If dblIst < dblWsF + 0.001 And dblIst > dblWsF - 0.001 Then
    'If 2 * rngIst.Value = WorksheetFunction.sum(Range(rngStart, rngIst)) Then
          rngIst.Offset(0, lngNext).Value = rngIst.Value  'ausgelesen und in eine Zelle geschrieben werden.
      Set rngStart = rngIst.Offset(1, 0)  'neuer Summenbeginn
    End If
  Next rngIst
    
Exit Sub
errorhandler:
End Sub