Registriert seit: 28.05.2017
Version(en): 365
25.08.2018, 12:05
(Dieser Beitrag wurde zuletzt bearbeitet: 25.08.2018, 12:05 von EasY.)
Hi Leute, ich benötige Hilfe bei folgendem Code: Code: Private Sub CommandButton_loeschen_Click()
Dim Frage As Integer
Frage = MsgBox("Der folgende Mitarbeiter und alle seine Urlaubswünsche werden unwiderruflich gelöscht: " + Chr(13) + Chr(13) + ListBox_Namensliste.Value, vbOKCancel + vbExclamation, "Mitarbeiter löschen?")
If Frage = vbOK Then 'Mitarbeiter löschen Dim finden As Range Set finden = ThisWorkbook.Sheets("Mitarbeiter").Range("A2:A50").Find(what:=ListBox_Namensliste.Value, lookat:=xlWhole) ThisWorkbook.Sheets("Mitarbeiter").Rows(finden.Row).Delete 'Urlaubswünsche löschen Dim last As Long last = ThisWorkbook.Sheets("Urlaubswuensche").Cells(Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Sheets("Urlaubswuensche").Range("A1:A" & last).AutoFilter field:=1, Criteria1:=ListBox_Namensliste.Text ThisWorkbook.Sheets("Urlaubswuensche").Range("A2:A" & last).SpecialCells(xlVisible).EntireRow.Delete ThisWorkbook.Sheets("Urlaubswuensche").Range("A1:A" & last).AutoFilter Unload UserForm_Mitarbeiter_entfernen Else Load UserForm_Mitarbeiter_entfernen End If
End Sub
Der Code funktioniert, solange in !Urlaubswuensche A2 etwas steht. Ich bekomme es allerdings nicht hin, da vorher eine Abfrage zu starten :(. Kann mir da wer bei helfen? Im Prinzip soll er den Part des Löschens von Urlaubwünschen nur ausführen, wenn in !Urlaubswuensche A2 etwas steht. Danke im voraus :)
Registriert seit: 13.04.2014
Version(en): 365
Hi, alle Dim-Anweisungen sollten am Anfang des Codes stehen! 1. Zeile: Code: If Range("a2")="" then exit sub
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr! Über Rückmeldungen würde ich mich freuen.
Registriert seit: 28.05.2017
Version(en): 365
25.08.2018, 12:14
(Dieser Beitrag wurde zuletzt bearbeitet: 25.08.2018, 12:14 von EasY.)
Hi Boskobiati,
das mit den dim-Anweisungen verstehe ich, da war ich vielleicht ein wenig unsauber, danke!
Dein Tipp erfüllt leider nicht alle meine Kriterien. Wenn A2 leer ist, soll er trotzdem noch den Mitarbeiter löschen. Nur nicht die Urlaubswünsche, da er dort in einen Laufzeitfehler läuft :(
Gruß
Registriert seit: 13.04.2014
Version(en): 365
Hi, da ich nicht weiß, wie das Ganze aussieht: Code: If Frage = vbOK and Range("A2")<>"" Then
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr! Über Rückmeldungen würde ich mich freuen.
Registriert seit: 28.05.2017
Version(en): 365
25.08.2018, 14:01
(Dieser Beitrag wurde zuletzt bearbeitet: 25.08.2018, 14:02 von EasY.)
Vielen Dank für deine Mühe, aber das ist auch nicht das, was ich brauche. Ich versuche es noch ein Mal genauer zu erklären: Mittels Userform "erstelle" ich Mitarbeiter. Die landen in !Mitarbeiter A:A. Mittels weiterer Userform können dann Urlaubswuensche für die jeweiligen Mitarbeiter erstellt werden. Diese landen in !Urlaubswuensche A:A Wenn ich nun einen Mitarbeiter entfernen möchte, soll er die gesamte Zeile in !Mitarbeiter A:A löschen, bei dem er den Namen findet. Ebenso soll er mit dem zweiten Teil des Codes alle Urlaubswuensche in !Urlaubswuensche löschen. Dies funktioniert jedoch nur, wenn überhaupt ein Urlaubswunsch vorhanden ist. Sofern gar keiner eingetragen, bzw. zu der Person (ich lasse ja vorher filtern) kein Urlaubswunsch eingetragen ist, haut er mir einen Fehler raus. Ich stelle mir das in etwa so vor (siehe Kommentar im letzten Drittel mit capslock): Code: Private Sub CommandButton_loeschen_Click()
Dim Frage As Integer
Frage = MsgBox("Der folgende Mitarbeiter und alle seine Urlaubswünsche werden unwiderruflich gelöscht: " + Chr(13) + Chr(13) + ListBox_Namensliste.Value, vbOKCancel + vbExclamation, "Mitarbeiter löschen?")
If Frage = vbOK Then 'Mitarbeiter löschen Dim finden As Range Set finden = ThisWorkbook.Sheets("Mitarbeiter").Range("A2:A50").Find(what:=ListBox_Namensliste.Value, lookat:=xlWhole) ThisWorkbook.Sheets("Mitarbeiter").Rows(finden.Row).Delete 'Urlaubswünsche löschen Dim last As Long last = ThisWorkbook.Sheets("Urlaubswuensche").Cells(Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Sheets("Urlaubswuensche").Range("A1:A" & last).AutoFilter field:=1, Criteria1:=ListBox_Namensliste.Text 'HIER SOLL ER ABFRAGEN,OB ÜBERHAUPT ETWAS IN DER GEFILTERTEN TABELLE VORHANDEN IST ThisWorkbook.Sheets("Urlaubswuensche").Range("A2:A" & last).SpecialCells(xlVisible).EntireRow.Delete ThisWorkbook.Sheets("Urlaubswuensche").Range("A1:A" & last).AutoFilter Unload UserForm_Mitarbeiter_entfernen Else Load UserForm_Mitarbeiter_entfernen End If
End Sub
Registriert seit: 02.12.2017
Version(en): Office 365
Kann es sein, dass er hir Code: ThisWorkbook.Sheets("Mitarbeiter").Rows(finden.Row).Delete
Hängen bleibt? Ich meine das gehört so Zitat:Code: ThisWorkbook.Sheets("Mitarbeiter").Rows(finden.Row).Delete Shift:=xlUp
Registriert seit: 09.09.2017
Version(en): O365
das Problem besteht ja in den Urlaubswünschen und dort darin, dass ein Bereich gelöscht werden soll, welcher nicht existiert. Man könnte auch hier mit .Find() prüfen ob denn ein Eintrag existiert und nur filtern/löschen wenn ein Eintrag gefunden wird. Bestimmt gibt es aber auch eine Möglichkeit, den Inhalt des Autofilters zu prüfen.
Willie
Registriert seit: 02.12.2017
Version(en): Office 365
den Bereich kann man auch abfragen und löschen mit: Code: For i = Last To 1 Step -1 If Rows(i).Hidden = False Then Rows(i).Delete End If Next
Registriert seit: 28.05.2017
Version(en): 365
25.08.2018, 23:36
(Dieser Beitrag wurde zuletzt bearbeitet: 25.08.2018, 23:36 von EasY.)
Hi Frogger, deine Löschvariante klingt auch sehr gut, allerdings hat sie nicht das Problem an sich gelöst. Kannst du so abschätzen, welche Performance besser sein dürfte? Wofür steht das shift:=xlup? Habe es dazugeschrieben, soweit ändert sich aber nichts am Ergebnis :) Habe den halben Tag weitergebastelt und nun folgende Formel zusammengeschustert.... bislang funktioniert sie super, oder sieht jemand, ob etwas fehlt? Code: Sub Wunschloeschen3()
Dim finden As Range Dim finden2 As Range Dim Frage As Integer Dim last As Long last = ThisWorkbook.Sheets("Urlaubswuensche").Cells(Rows.Count, 1).End(xlUp).Row Set finden = ThisWorkbook.Sheets("Mitarbeiter").Range("A2:A50").Find(what:="Name", lookat:=xlWhole) Set finden2 = ThisWorkbook.Sheets("Urlaubswuensche").Range("A1:A" & last).Find(what:="Name", lookat:=xlWhole) Frage = MsgBox("Der folgende Mitarbeiter und alle seine Urlaubswünsche werden unwiderruflich gelöscht: " + Chr(13) + Chr(13), vbOKCancel + vbExclamation, "Mitarbeiter löschen?")
Select Case Frage Case vbOK And finden2 Is Nothing ThisWorkbook.Sheets("Mitarbeiter").Rows(finden.Row).Delete shift:=xlUp Unload UserForm_Mitarbeiter_entfernen Case vbOK ThisWorkbook.Sheets("Mitarbeiter").Rows(finden.Row).Delete shift:=xlUp ThisWorkbook.Sheets("Urlaubswuensche").Range("A1").AutoFilter field:=1, Criteria1:="Name" ThisWorkbook.Sheets("Urlaubswuensche").Range("A2:A" & last).SpecialCells(xlVisible).EntireRow.Delete shift:=xlUp ThisWorkbook.Sheets("Urlaubswuensche").Range("A1").AutoFilter Unload UserForm_Mitarbeiter_entfernen End Select
End Sub
P.S.: Die Bedingung von A2 muss gefüllt sein habe ich nun noch angepasst. Nur A2 gefüllt reichte nicht aus. Es soll auch zu dem Mitarbeiter natürlich ein Wunsch vorhanden sein :) P.S.S.: Zu früh gefreut ... irgendwo hängt er wieder :(. Die Delete-Methode des Rangeobjekts konnte nicht ausgeführt werden.
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo, Sub Wunschloeschen3() Dim finden As Range Dim finden2 As Range Dim Frage As Integer Dim last As Long last = ThisWorkbook.Sheets("Urlaubswuensche").Cells(Rows.Count, 1).End(xlUp).Row Set finden = ThisWorkbook.Sheets("Mitarbeiter").Range("A2:A50").Find(what:="Name", lookat:=xlWhole) Set finden2 = ThisWorkbook.Sheets("Urlaubswuensche").Range("A1:A" & last).Find(what:="Name", lookat:=xlWhole) Frage = MsgBox("Der folgende Mitarbeiter und alle seine Urlaubswünsche werden unwiderruflich gelöscht: " + Chr(13) + Chr(13), vbOKCancel + vbExclamation, "Mitarbeiter löschen?") If Frage = vbOK Then If Not finden Is Nothing Then finden.EntireRow.Delete shift:=xlUp If Not finden2 Is Nothing And last > 1 Then With finden2.Parent .Range("A1").AutoFilter field:=1, Criteria1:="Name" .Range("A2:A" & last).SpecialCells(xlVisible).EntireRow.Delete shift:=xlUp .Range("A1").AutoFilter End With Unload Me End If End If End If End Sub Gruß Uwe
|