Thema Datum  Von Nutzer Rating
Antwort
Rot Nachkommastellen werden nicht berücksichtigt
 28.01.2008 08:38:40 Andi
NotSolved
28.01.2008 09:17:50 Holger
NotSolved
28.01.2008 09:29:49 Andi
NotSolved
28.01.2008 09:53:53 Holger
NotSolved
28.01.2008 10:04:09 Andi
NotSolved
28.01.2008 13:26:21 Andi
NotSolved
28.01.2008 16:47:26 Holger
NotSolved
28.01.2008 13:21:52 Andi
NotSolved

Ansicht des Beitrags:
Von:
Andi		 Datum:
28.01.2008 08:38:40		 Views:
2486		 Rating:
     
Antwort:
  Ja
Thema:
Nachkommastellen werden nicht berücksichtigt
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

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
Rot Nachkommastellen werden nicht berücksichtigt
 28.01.2008 08:38:40 Andi
NotSolved
28.01.2008 09:17:50 Holger
NotSolved
28.01.2008 09:29:49 Andi
NotSolved
28.01.2008 09:53:53 Holger
NotSolved
28.01.2008 10:04:09 Andi
NotSolved
28.01.2008 13:26:21 Andi
NotSolved
28.01.2008 16:47:26 Holger
NotSolved
28.01.2008 13:21:52 Andi
NotSolved