Hi Holger,
hast Du mir noch mal das gleiche geschrieben ?
Gruß
Andi
Holger schrieb am 29.01.2008 12:45:17:
Hallo Andi,
was funktioniert denn nicht mehr?
Werden nicht alle Zeilen übertragen oder gelöscht?
Werden falsche Zeilen übertragen oder gelöscht?
Hast du die
Private Sub Worksheet_Change(ByVal Target As Range)
im Codeteil für deine Tabelle1 (gemäß der Auflistung unter Microsoft Excel Objekte im Projektfenster) untergebracht und die übrigen Codeteile einschließlich
Option Explicit
Public Suchbegriff As String 'Kontoname
in einem Modul?
Dein Code ist auf den ersten Blick o.K., wobei ich ihn nicht installiert habe. Durch das x=x-1 in der For-Next-Schleife hat die letzte zu unteruchende Zeile zwar nicht mehr die Nummer letzteZeile, aber darunter stehen nur Leerzeilen, so dass kein Problem auftreten sollte.
Gruß
Holger
Andi schrieb am 28.01.2008 19:37:58:
Hallo Holger,
normalerweise greift das Makro wenn ich (siehe Beispiel) -0,01 eingebe. Da der Saldo 0,00 ergibt (0,25 - 0,24 - 0,01) verschieben sich sofort alle Posten mit dem Namen "Testname1" in das andere Tabellenblatt. Übrig bleibt lediglich der Posten "Testname2" mit 0,30.
Posten mit dem gleichem Namen bleiben so lange in Tabellenblatt1 stehen, bis der Saldo 0,00 ergibt.
Leider funktioniert das nun nicht mehr. Ich habe keine Ahnung warum.
Davor hat es immer funktioniert, aber nur mit Zahlen > 0,50.
Danke für Deine Hilfe !!!!
--------------------------
Holger schrieb am 28.01.2008 16:59:15:
Hallo Andi,
was funktioniert nicht. Wo bleibt das Array stecken? Beschreibe bitte den Fehler
Gruß
Holger
Andi schrieb am 28.01.2008 14:56:45:
Hallo nochmal,
verwende jetzt den folgenden Code und habe leider immer noch ein Problem.
Nochmal kurz zum eigentlichem Nutzen des Codes.
Ich habe u.a. die Spalte Name und Betrag.
Name: Betrag:
Testname1 0,25
Testname1 -0,24
Testname2 0,30
Testname1 -0,01
Sobald die Summe (Saldo) der Beträge 0,00 ergibt, soll eine Verschiebung von Tabellenblatt1 in Tabellenblatt2 erfolgen. Also wenn ich hier im Beispiel Testname1 und -0,01 eingebe soll alles was auf den Namen Testname1 lautet in das andere Tabellenblatt verschoben werden.
Dank Holger funktioniert es nun auch z.B. 0,25 einzugeben. Das ging vorher nicht - alles was unter 0,50 war wurde sofort verschoben. Habe alles was auf "as Long" lautete auf "as Double" geändert.
Allerdings funktioniert die Verschiebung nun nicht mehr richtig. Denn wenn ich wie im Beispiel eingebe, müsste alles was Testname1 hat verschoben werden - tut es aber leider nicht.
Kann mir jemand sagen, was ich im Code falsch habe ???
Vielen Dank !!!!!!
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 Double '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 Double 'von blatt erledigte konten
Dim letzteZeile As Double 'von blatt 1
Dim x As Double
Dim Kontrollsumme As Double 'ü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
------------------------------------------------------------------
Andi schrieb am 28.01.2008 10:04:09:
Hi Holger,
es funktioniert ! Ich danke Dir vielmals !!!!
Holger schrieb am 28.01.2008 09:53:53:
Hallo Andi,
Ersetze
Dim Ergebnis As Long 'gezählte Summe
durch z.B.
Dim Ergebnis As Double 'gezählte Summe
Ich habe dein Makro nicht getestet, bin mir aber sicher, dass das der Fehler ist.
Gruß
Holger
Andi schrieb am 28.01.2008 09:29:49:
Hallo Holger,
kannst Du mir dabei evtl. helfen. Um ehrlich zu sein kenne ich mich damit nicht wirklich aus!!
Holger schrieb am 28.01.2008 09:17:50:
Hallo Andi,
du hast Ergebnis als Long-Datentyp deklariert. Long sind Ganzzahl-Variablen, d.h. 0.25 wird 0, 0.51 wird 1. Verwende Single oder Double.
Gruß
Holger
Andi schrieb am 28.01.2008 08:38:40:
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
|