Letzte Zeile mit Bedingung löschen

Hallo Forum
Bastele immer noch an meiner Auftragsverwaltung herum. Folgendes Problem hat sich jetzt noch ergeben. Kurze Erklärung: In Tb Einträge lege ich die komplett-Aufträge an. Für den Produktionsstatus brauche ich daraus die ganze Zeile, für die Einträge in die Laufkarte nur bestimmte Einträge. Wenn jetzt in der Letzten Zeile eine Fehleingabe getätigt worden ist und diese gebucht worden ist, möchte ich, dass die letzte Buchung (Letzte Zeile) aus Tb Produktionsstatus und Eintr-Laufkarte gelöscht werden. Ich habe zwar einen Code der die letzte Zeile löscht, aber mit einem nervösen Zeigefinger meiner Kollegen :-) werden dann eventuell mehrere Zeilen gelöscht. Daher sollten die Zeilen nur gelöscht werden, wenn die Best. Nr. identisch ist. Zum besseren Verständnis lade ich mal eine Beispiel-Datei hoch.
Für Eure Hilfe schon mal ein herzliches Danke schön.
https://www.herber.de/bbs/user/116717.xlsm
Gruß, Guesa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Fehleintrag_raus() Dim loWertE As Long 'Wert Einträge Dim loWertP As Long 'Wert Produktionsstatus Dim loWertL As Long 'Wert Eintr-Laufzettel If IsNumeric(Worksheets("Einträge").Cells(Rows.Count, 3).End(xlUp)) Then loWertE = Worksheets("Einträge").Cells(Rows.Count, 3).End(xlUp) End If If IsNumeric(Worksheets("Produktionsstatus").Cells(Rows.Count, 3).End(xlUp)) Then loWertP = Worksheets("Produktionsstatus").Cells(Rows.Count, 3).End(xlUp) End If If IsNumeric(Worksheets("Eintr-Laufkarte").Cells(Rows.Count, 3).End(xlUp)) Then loWertL = Worksheets("Eintr-Laufkarte").Cells(Rows.Count, 3).End(xlUp) End If If loWertE = loWertP And loWertE = loWertL Then Worksheets("Produktionsstatus").Cells(Rows.Count, 3).End(xlUp).EntireRow.Delete Worksheets("Eintr-Laufkarte").Cells(Rows.Count, 3).End(xlUp).EntireRow.Delete Else MsgBox "Löschen nicht möglich, da es sich" & vbLf _ & "unterschiedliche Bestellnummern handelt." End If End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False If Target.Column 7 Then Exit Sub If IsEmpty(Target) Then Exit Sub Dim eRow As Long, eRowL As Long eRow = Target.Row With Worksheets("Produktionsstatus") If IsEmpty(.Range("A1")) Then eRowL = 1 Else eRowL = .Cells(Rows.Count, 1).End(xlUp).Row + 1 End If Range(Cells(eRow, 1), Cells(eRow, 7)).Copy .Cells(eRowL, 1).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False '.Columns.AutoFit End With If Target.Column 7 Then Exit Sub If IsEmpty(Target) Then Exit Sub Dim iRow As Long, iRowL As Long iRow = Target.Row With Worksheets("Eintr-Laufkarte") If IsEmpty(.Range("B1")) Then iRowL = 1 Else iRowL = .Cells(Rows.Count, 1).End(xlUp).Row + 1 End If If Cells(iRow, 2).Value > "" Then Range(Cells(iRow, 8), Cells(iRow, 11)).Copy .Cells(iRowL, 1).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False '.Columns.AutoFit End If End With Application.ScreenUpdating = True End Sub

Hallo,
teste:

Public Sub Fehleintrag_raus()
Dim loWertE As Long 'Best.Nr. Einträge
Dim loWertP As Long 'Best.Nr. Produktionsstatus
Dim loWertL As Long 'Best.Nr. Eintr-Laufzettel
Dim loWertENr As Long 'lfd. Nummer Einträge
Dim loWertLNr As Long 'lfd. Nummer Eintr-Laufzettel
If IsNumeric(Worksheets("Einträge").Cells(Rows.Count, 3).End(xlUp)) Then
loWertE = Worksheets("Einträge").Cells(Rows.Count, 3).End(xlUp)
loWertENr = Worksheets("Einträge").Cells(Rows.Count, 3).End(xlUp).Offset(, -1)
Else
Exit Sub
End If
If IsNumeric(Worksheets("Produktionsstatus").Cells(Rows.Count, 3).End(xlUp)) Then
loWertP = Worksheets("Produktionsstatus").Cells(Rows.Count, 3).End(xlUp)
End If
If IsNumeric(Worksheets("Eintr-Laufkarte").Cells(Rows.Count, 3).End(xlUp)) Then
loWertL = Worksheets("Eintr-Laufkarte").Cells(Rows.Count, 3).End(xlUp)
loWertLNr = Worksheets("Eintr-Laufkarte").Cells(Rows.Count, 3).End(xlUp).Offset(, -2)
End If
If MsgBox("Letzten Eintrag tatsächlich löschen?", vbYesNo, "Sicherheitsabfrage") = vbNo Then  _
Exit Sub
If loWertE = loWertP And loWertE = loWertL And loWertENr > 0 And loWertENr = loWertLNr Then
Worksheets("Produktionsstatus").Cells(Rows.Count, 3).End(xlUp).EntireRow.Delete
Worksheets("Eintr-Laufkarte").Cells(Rows.Count, 3).End(xlUp).EntireRow.Delete
Worksheets("Einträge").Cells(Rows.Count, 3).End(xlUp) = "Fehleintrag"
ElseIf loWertE = loWertP Then
Worksheets("Produktionsstatus").Cells(Rows.Count, 3).End(xlUp).EntireRow.Delete
Worksheets("Einträge").Cells(Rows.Count, 3).End(xlUp) = "Neu erfassen"
Else
MsgBox "Keine identischen Bestellnummern."
End If
End Sub

Da ist jetzt vor dem Löschen der Daten noch eine Sicherheitsabfrage drin.
Zudem setze ich den letzten Wert Spalte C im Blatt "Einträge" auf "Neu erfassen".
Das hat folgenden Grund:
Wenn dein "User" den letzten Eintrag aufgrund Fehlerfassung löscht und dann das Makro erneut ausführt, dann würde der jetzt letzte Eintrag bei Übereinstimmung der Bestellnummer ebenfalls gelöscht. In deiner Beispieldatei würde das zutreffen, somit wären dann beide Einträge weg (Kennwort "Nervöse Finger").
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Letzte Zeile mit Bedingung löschen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Letzte Zeile mit Bedingung löschen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread