Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Historie erstellen lassen

VBA Historie erstellen lassen
30.03.2016 16:07:03
Stefan
Guten Tag,
ich bin noch ganz neu hier, habe mich aber schon durch den ein oder anderen Beitrag gelesen. Ich denke ihr könnt mir bestimmt helfen.
Um es direkt auf den Punkt zu bringen, mein VBA Code ist "zusammengesucht" und angepasst.
Problem:
Ich habe eine Excel Tabelle mit 2 Tabellenblättern.
Im ersten Tabellenblatt werden alle anstehenden Montagen aufgeführt.
In Spalte Y trage ich ein "ü" ein wenn die Montage komplett abgeschlossen ist.
Folgendes soll dann passieren:
Ist die Montage abgeschlossen (in Spalte Y ein ü eingetragen), nehme die gesamte Zeile (z.B A2-Y2) und kopiere Sie auf das 2te Tabellenblatt in die erste komplett freie Zeile (z.B. A2-Y2).
Danach lösche die vorher kopierte gesamte Zeile vom 1 Tabellenblatt.
Mit folgendem Code klappt das bedingt auch schon ganz gut:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = ("25") Then 'Änderung in Spalte Y
If Target.Value  "" Then
If MsgBox("Ist die Montage wirklich abgeschlossen?", vbYesNo, "Achtung!" _
) = vbYes Then
lrow = Sheets("Tabelle2").Range("E65536").End(xlUp).Row + 1 '1. freie Zeile wird ermittelt
Range("A" & Target.Row & ":Y" & Target.Row).Cut Sheets("Tabelle2").Range("A" & lrow & ":Y" & _
lrow)
Else: Exit Sub
End If
End If
End If
End Sub

Steht jetzt in Spalte Y ein ü, dann wird die Zeile auf Blatt 2 kopiert und anschließend vom ersten Blatt "Montagen 2016" entfernt.
Und jetzt kommt mein Problem an dem ich mir seit 2 Tagen die Zähne ausbeiße.
1. Auf dem 2ten Tabellenblatt wird meine Historie immer überschrieben, wenn z.B. im ersten Tabellenblatt nur A2 gefüllt ist. Sind alle Zellen bis Y gefüllt, wird eine vernünftige Historie erstellt.
2. Er löscht mir zwar den Zelleninhalt auf Blatt 1, jedoch nicht die gesamte Zeile (Ich will keine Leerzeilen im 1ten Tabellenblatt)
Frage:
Was muss ich ändern, damit er mir auf dem 2ten Blatt eine immer fortlaufende Historie erstellt. Ohne das es ständig überschrieben wird.
Und, wie schaffe ich es das die gesamte Zeile ausgeschnitten wird vom Blatt 1 und nicht nur der Inhalt.
Eine Beispieldatei habe ich hochgeladen
https://www.herber.de/bbs/user/104663.xlsm
Auch dort tritt hoffentlich bei euch die Situation ein das wenn Zeile 3 -5 aufs 2te Blatt rüber geschoben wurden, ihr Leerzeilen habt und in dem Moment wo ihr die Zeilen 6-8 via dem Script verschiebt, er zumindest die Daten aus ehemals Zeile 5 überschreibt.
ich hoffe ich habs einigermaßen verständlich voreinander bekommen.
Falls ich etwas vergessen habe fragt bitte kurz nach. Ich werde schnellstmöglich antworten.
Danke für eure Unterstützung.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Historie erstellen lassen
30.03.2016 16:27:42
Fennek
Hallo Stefan,
ich kann deine Datei nicht öffnen (xlsm) und der code ist ungeprüft:

If Target.column = 25 and target.value = "ü"  then
Lr = sheets("tabelle2").range("a1").specialcell(xlcelltypelastcell).row
Range(cells(target.row, "A"), cells(target.row, "Y")). Copy sheets("tabelle2").cells(lr, "A")
Rows(target.row).entirerow.delete
End if
End sub
Bitte an einer Kopie testen.
Mfg

AW: VBA Historie erstellen lassen
30.03.2016 16:39:40
Stefan
Hi,
erst einmal danke für die schnelle Rückmeldung.
Bei deinem Code bekomme ich einen Laufzeitfehler 438.
Ich habe die Datei noch mal ohne Makros zur Ansicht hochgeladen.
https://www.herber.de/bbs/user/104665.xlsx

Anzeige
AW: VBA Historie erstellen lassen
30.03.2016 17:04:14
Fennek
Hallo Stefan,
füge bitte als erste Zeile ein
Application.enableEvents = false
Und als letzte Zeile
Appplication.enableEvents = true
Setze bitte auf die erste Zeile einen Haltepunkt (F9 im vba Fenster) und gehe den Code im Einzelschritt (F8) durch.
Der Makro erwartet ein "ü" in der Spalte Y, in deiner Datei steht ein "Haken".
Mfg

AW: VBA Historie erstellen lassen
31.03.2016 09:32:15
Stefan
Hallo Fennek,
entschuldige bitte das ich mich so blöd anstelle aber schau bitte mal ob ich deinen Vorschlag richtig umgesetzt habe:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False                         'hier habe ich die Haltemarke gesetzt.
If Target.Column = 25 And Target.Value = "ü" Then
lr = Sheets("tabelle2").Range("a1").specialcell(xlCellTypeLastCell).Row + 1
Range(Cells(Target.Row, "A"), Cells(Target.Row, "Y")).Copy Sheets("tabelle2").Cells(lr, "A")
Rows(Target.Row).EntireRow.Delete
Appplication.EnableEvents = True
End If
End Sub
Denn bei mir tut sich da leider nichts.
Der Haken den du angesprochen hast ist ein "ü" in der Schriftart Wingdings - stellt die optische Darstellung für VBA ein Problem da?
Wenn ich in der Ersten Zeile im VBA Editor die Haltemarke setze und die Einzelschritte versuchte durchzuführen, tut sich ebenfalls nichts. Ich habe mich dann versucht schlau zu lesen. Ist es nicht so das die Zeile "Application.enableEvents = false" die Change Funktion aussetzt ? Daher sicherlich auch dann deine bitte die Einzelschritte durchzuführen, da nur so getestet werden kann.
Eine Veränderung in der Tabelle selber (sprich "ü" setzen) hat somit erst einmal keine Auswirkung mehr. Dafür müssten diese Zeilen wieder entferne werden, oder habe ich das falsch verstanden ?
Liebe Grüße
Stefan

Anzeige
AW: VBA Historie erstellen lassen
31.03.2016 10:09:29
Steve
Hallo Stefan,
ein ü in der Zelle gibt auch ein ü als Cell.Value zurück, die Formatierung spielt dabei keine Rolle.
EnableEvents setzt das Ereignis außer Kraft, das ist richtig, denn mit dem Ausschneiden/Löschen aus der Zelle nimmst du wieder eine Änderung vor, welche das Makro erneut auslösen würde. Um diese Rückkopplung zu vermeiden muss es am Anfang ausgestellt werden. Zum Schluss natürlich wieder einschalten, versteht sich. Dein Problem ist jedoch, dass du das Einschalten in die If-Bedingung gepackt hast, also nicht immer ausgeführt wird. Damit kannst du die Events ein-/ausschalten damit dein Makro wieder funktioniert:
Sub EventsEinAus()
With Application
.EnableEvents = Not .EnableEvents
MsgBox "Events Ein = " & .EnableEvents
End With
End Sub

Rows(Target.Row).EntireRow.Delete
Diese Zeile ist doppelt gemoppelt ("Lösche für Zeile X die komplette Zeile), funktioniert aber dennoch. Entweder nehme ich eine Zeile (Row) und lösche sie oder ich nehme eine Zelle lösche davon die komplette Zeile. Also entweder:
Rows(Target.Row).Delete
oder
Target.EntireRow.Delete

Anzeige
AW: VBA Historie erstellen lassen
31.03.2016 10:39:11
Stefan
Hallo Steve,
Hallo Fennek,
euch gilt mein Dank und voller Respekt.
Es funktioniert genau wie von euch beschrieben.
Da habt ihr heute wen glücklich gemacht :)
DANKE

AW: ei +1 fehlt
30.03.2016 17:11:01
Fennek
Hallo Stefan,
In der Zeile lr muss am Ende eine '+1' angehängt werden, damit in eine leere Zeile im sheet(2) kopiert wird.
Mfg

AW: VBA Historie erstellen lassen
31.03.2016 09:23:14
Steve
Hallo Stefan,
zu deinem ersten Problem:
Die erste freie Spalte wird bei dir anhand der Spalte E ermittelt.
lrow = Sheets("Tabelle2").Range("E65536")...
Finde also eine Spalte in der definitiv ein Wert steht und passe den Buchstaben an. Ob dabei Spalte A richtig ist, kann ich nicht beurteilen.
Ich habe dein Makro anhand von Fenneks Vorschlägen modifiziert ohne es komplett neu zu schreiben. Falls für dich zwingend ein "ü" in der Zelle stehen muss ändere die folgende Zeile. Bislang schien diese Anforderung ja nicht notwendig gewesen zu sein:
If Target.Value  "" Then
in
If Target.Value = "ü" Then
lg Steve
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Count = 1 And Target.Column = ("25") Then 'Änderung in Spalte Y
If Target.Value  "" Then
If MsgBox("Ist die Montage wirklich abgeschlossen?", vbYesNo, "Achtung!") = vbYes Then
lrow = Sheets("Tabelle2").Range("A65536").End(xlUp).Row + 1 '1. freie Zeile
Range("A" & Target.Row & ":Y" & Target.Row).Copy Sheets("Tabelle2").Range("A" & lrow)
Target.EntireRow.Delete
End If
End If
End If
Application.EnableEvents = True
End Sub

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige