Hallo Zusammen,
vielleicht kann mir jemand weiterhelfen.
Es geht um eine Verschiebung von einem Tabellenblatt1 in Tabellenblatt2 wenn der Saldo von gleichlautenden Posten 0(null) ergibt. Ich habe allerdings bemerkt, dass bei der Verwendung von z.B. 0,25 sofort verschoben wird. Vermutlich rundet das Programm ab und erkennt den Posten als 0 und verschiebt. Ab 0,51 und darüber besteht diese Problematik nicht.
Kann mir jemand den Code so abändern, dass auch die Nachkommastellen richtig laufen ?
Code:
Option Explicit
Public Suchbegriff As String 'Kontoname
Private Sub Worksheet_Change(ByVal Target As Range)
'wenn nicht gesetzt, wird ereignis immer wiederholt
Application.EnableEvents = False
Dim Ergebnis As Long 'gezählte Summe
Suchbegriff = ""
Ergebnis = 1
'wenn eingabe in spalte 8, dann zählen
If Target.Column = 8 Then
'suchbegriff von spalte 1 eingegebener zeile
Suchbegriff = Sheets(1).Cells(Target.Row, 1).Value
Ergebnis = WorksheetFunction.SumIf([A:A], Suchbegriff, [H:H])
'MsgBox Ergebnis
End If
'wenn ergebnis gleich 0 dann aktion
If Ergebnis <> 0 Then
Else
übertragen
End If
'wieder aufheben
Application.EnableEvents = True
End Sub
Sub übertragen()
Dim Ausgabezeile As Long 'von blatt erledigte konten
Dim letzteZeile As Long 'von blatt 1
Dim x As Long
Dim Kontrollsumme As Long 'übertragene Summe wird mitgezählt
Kontrollsumme = 0
'MsgBox Suchbegriff
letzteZeile = Sheets(1).Range("A65536").End(xlUp).Row
Ausgabezeile = Sheets("erledigte Konten").Range("A65536").End(xlUp).Row + 1
For x = 2 To letzteZeile
If Sheets(1).Cells(x, 1).Value = Suchbegriff Then
Kontrollsumme = Kontrollsumme + Sheets(1).Cells(x, 8).Value
'ausschneiden und einfügen
With Sheets(1)
.Rows(x).Copy
End With
Sheets("erledigte Konten").Range("A" & Ausgabezeile).Insert
Sheets(1).Rows(x).Delete shift:=xlUp
x = x - 1
Ausgabezeile = Ausgabezeile + 1
End If
Next x
If Kontrollsumme <> 0 Then
MsgBox "Achtung, übertragene Summe ist nicht 0", vbCritical, "Fehler bei Übertragung"
End If
End Sub
Sub test()
Application.EnableEvents = True
End Sub
Vielen Dank für die Hilfe !!
Gruß
Andi |