Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Tabelle löschen wenn Name in Zeile gelöscht wird


Betrifft: Tabelle löschen wenn Name in Zeile gelöscht wird von: Philip
Geschrieben am: 22.01.2019 12:34:51

Hallo,

Ist es möglich eine erstellte Tabelle(Worksheet) zu löschen wenn eine Zeile in einer anderen Tabelle gelöscht wird?

Beispiel.

Über eine Userform schreibe ich eine neue Zeile mit dem Namen Peter. Daraufhin wird eine Tabelle mit dem Namen Peter erstellt.

Ich möchte nun das wenn ich die Zeile wo Peter drin steht komplett mit Mausklick lösche, die tabelle mit dem Namen Peter auch gelöscht wird.

Ich danke euch :)

  

Betrifft: AW: Tabelle löschen wenn Name in Zeile gelöscht wird von: Daniel M.
Geschrieben am: 22.01.2019 13:00:08

Hallo Philip,

eine Beispieldatei anstatt eines beschriebenen Beispiels würde hier sehr helfen.

Grüße
Daniel


  

Betrifft: AW: Tabelle löschen wenn Name in Zeile gelöscht wird von: Philip
Geschrieben am: 23.01.2019 08:15:23

https://www.herber.de/bbs/user/127015.xlsm

Von Uwe der Code funktionier bedingt. Ich habe alles auf Spalte B bezogen und musste in meinem Code der Userform das erstellen der Tabellenblätter raus nehmen.

Bei dem Code von Uwe wirft er jedoch erst einen Fehler raus und wnen ich die Userform beende erstellt er das Blatt. Auch beim löschen zeigt er erst Fehler 13 Typen nicht verträglich nach bestätigung löscht er aber das entsprechende Blatt


  

Betrifft: AW: Tabelle löschen wenn Name in Zeile gelöscht wird von: UweD
Geschrieben am: 23.01.2019 09:28:01

Wie soll denn das Löschen ausgelöst werden?

Ich hatte es so vorgesehen, wenn in eine Spalte A (jetzt bei dir gewünscht B) ein Eintrag entfernt wird...


Da das nicht so ohne Weiteres geht, der Umweg...

Ich hatte deshalb bei JEDER Änderung in der Spalte Alle Tabellenblätter geprüft, ob deren Name in DER Spalte vorkommt. Wenn nicht, dann weg damit.


Wenn du das Neuanlegen sowieso über die Userform machst, kann der Part aus meinem Code ja raus.
So wie ich das sehe, sollen ja weitere Blätter ausgenommen werden.


Das abgeänderte Makro (muss in den Bereich des Tabellenblattes).


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    Dim Blatt, SP As Integer, TMP As Variant, Neu
    
    '*** Stammdaten Anfang 
    SP = 2 'Überwachte Spalte 
    '*** Stammdaten Ende 
    
    If Not Intersect(Columns(SP), Target) Is Nothing Then
        If Target.Count = 1 Then
            Application.ScreenUpdating = False
            
            'Prüfung ob gelöscht werden kann 
            For Each Blatt In ThisWorkbook.Sheets
                Select Case Blatt.Name
                    Case "MECH", "MAF", "EBT", "WM", "IM", "MusterMechatronik"
                        'Mach nichts 
                    Case Else
                    
                        If WorksheetFunction.CountIf(Columns(SP), Blatt.Name) = 0 Then
                            'Blattname nicht vorhanden 
                            Application.DisplayAlerts = False
                            Blatt.Delete
                            Application.DisplayAlerts = True
                            
                            'gesamte Zeile löschen 
                            Application.EnableEvents = False
                            Rows(Target.Row).Delete xlUp
                            Application.EnableEvents = True

                        End If
                End Select
            Next
        End If
    End If
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Aber dein Code der Userform muss auch noch abgeändert werden

Private Sub Button_Eingabe_Click()
    On Error GoTo Fehler

    'Vermeiden von Doppelt benanntem Nachnamen (MECH) 
    Dim Bereich As Range
    Dim Name As String
    Name = Bedienfeld.TextBox_Nachname

    Dim Letzte As Long
    If [D65536] = "" Then
        Letzte = [D65536].End(xlUp).Row
    Else
        Letzte = 65536
    End If
    Set Bereich = Sheets("MECH").Range("b8:B" & Letzte) _
        .Find(Bedienfeld.TextBox_Nachname)
    If Bereich Is Nothing Then
'       Keine weiteren AktionenAktion 
    Else
        If Bedienfeld.TextBox_Nachname.Value = "" Then
            MsgBox ("Bitte Nachname eingeben")
        Else
            MsgBox "Nachname '" & Name & "' prüfen! Nachname schon vorhanden. Bitte durchnummerieren z.B'" & Name & " 1'"
            Bedienfeld.TextBox_Nachname = ""
        End If
    End If

    If Bedienfeld.TextBox_Nachname.Value = "" Then
      'Keine Aktion 
    
    Else
        If Bedienfeld.TextBox_Vorname.Value = "" Then
            MsgBox ("Bitte Vornamen eingeben")
        Else
            If Bedienfeld.TextBox_Personalnummer.Value = "" Then
                MsgBox ("Bitte Personalnummer eingeben")
    
            Else
                Dim letzteZeile As Long
                letzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
                
                'Events temporär ausschalten 
                Application.EnableEvents = False
    
                Rows(letzteZeile + 1).Insert  'Zeile einfügen 
                Rows(letzteZeile).Copy Cells(letzteZeile + 1, 1)  'Zeile kopieren 
                
                'Daten aus dem Textfeld schreiben 
                ActiveSheet.Cells(letzteZeile + 1, "B").Value = Bedienfeld.TextBox_Nachname.Value
                ActiveSheet.Cells(letzteZeile + 1, "C").Value = Bedienfeld.TextBox_Vorname.Value
                ActiveSheet.Cells(letzteZeile + 1, "D").Value = Bedienfeld.TextBox_Personalnummer.Value

                'Events temporär ausschalten 
                Application.EnableEvents = True
                
                'kopiere MusterBlatt und benenne es nach eingabe in Textboxen 
                ActiveWorkbook.Worksheets("MusterMechatronik").Copy after:=ActiveWorkbook.Sheets(Sheets.Count)
                ActiveSheet.Name = Bedienfeld.TextBox_Nachname


                'Wieder zur Ausgangsansicht 
                Sheets("MECH").Select 'Für jede Berufgruppe ändern 
                Range("A1").Select

                'Erzeugen von Hyperlink 
                Dim Tabelle As String
                    
                Dim r As Long
                
                r = 8
                
                With ThisWorkbook.ActiveSheet 'Worksheet für Jede Berufsgruppe ändern 
                
                    Do While .Range("B" & r) <> ""
                        
                        Tabelle = .Range("B" & r).Value
                    
                      .Hyperlinks.Add Anchor:=.Range("B" & r), _
                        Address:="", SubAddress:="'" & Tabelle & "'!C5", _
                        TextToDisplay:=Tabelle
                        
                        r = r + 1
                    Loop
                End With

                Load Bedienfeld

                Bedienfeld.TextBox_Nachname = ""
                Bedienfeld.TextBox_Vorname = ""
                Bedienfeld.TextBox_Personalnummer = ""
                
                
                
            End If
        End If
    End If
    
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Private Sub Button_Zurück_Click()
    'Eingabefenster schließen 
    Unload Bedienfeld
End Sub

LG UweD


  

Betrifft: AW: Tabelle löschen wenn Name in Zeile gelöscht wird von: Philip
Geschrieben am: 23.01.2019 09:41:30

Hammer , vielen lieben Dank. So habe ich mir das vorgestellt :)

Wahnsinn wie schnell du das gemacht hast.

Wirklich ganz ganz großen Dank :)


  

Betrifft: AW: Tabelle löschen wenn Name in Zeile gelöscht wird von: Philip
Geschrieben am: 23.01.2019 09:51:48

Hammer , vielen lieben Dank. So habe ich mir das vorgestellt :)

Wahnsinn wie schnell du das gemacht hast.

Wirklich ganz ganz großen Dank :)


  

Betrifft: Prima! Danke für die Rückmeldung. owT von: UweD
Geschrieben am: 23.01.2019 10:06:02




  

Betrifft: AW: Prima! Danke für die Rückmeldung. owT von: Philip
Geschrieben am: 24.01.2019 08:23:26

Ich habe dann doch nochmal eine Frage, was muss ich hinzufügen damit das löschen durch eine messagebox erst bestätigt werden muss?


  

Betrifft: AW: Prima! Danke für die Rückmeldung. owT von: UweD
Geschrieben am: 24.01.2019 09:02:55

hallo

Hier inkl. der gewünschten Änderung

Microsoft Excel Objekt Tabelle4

Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
    On Error GoTo Fehler 
    Dim Blatt, SP As Integer, TMP As Variant, Neu 
    Dim JaNein, Vorher As String 
     
    '*** Stammdaten Anfang 
    SP = 2 'Überwachte Spalte 
    '*** Stammdaten Ende 
     
    If Not Intersect(Columns(SP), Target) Is Nothing Then 
        If Target.Count = 1 Then 
            Application.ScreenUpdating = False 
             
            'prüfen ob Zelle vorher gefüllt war und jetzt leer ist 
            With Application 
                .EnableEvents = False 
                .Undo 
                Vorher = Target.Value 
                .Undo 
                If Vorher <> "" And Target.Value = "" Then 
                    'Löschen bestätigen 
                    JaNein = MsgBox("Wirklich löchen?", vbYesNo + vbQuestion, "Eintrag löschen") 
                    If JaNein = vbNo Then 
                        .Undo 
                        .EnableEvents = True 
                        Exit Sub 
                    End If 
               End If 
               .EnableEvents = True 
            End With 
                 
             
            'Prüfung ob Blatt gelöscht werden kann 
            For Each Blatt In ThisWorkbook.Sheets 
                Select Case Blatt.Name 
                    Case "MECH", "MAF", "EBT", "WM", "IM", "MusterMechatronik" 
                        'Mach nichts 
                    Case Else 
                     
                        If WorksheetFunction.CountIf(Columns(SP), Blatt.Name) = 0 Then 
                            'Blattname nicht vorhanden 
                            Application.DisplayAlerts = False 
                            Blatt.Delete 
                            Application.DisplayAlerts = True 
                             
                            'gesamte Zeile löschen 
                            Application.EnableEvents = False 
                            Rows(Target.Row).Delete xlUp 
                            Application.EnableEvents = True 
 
                        End If 
                End Select 
            Next 
        End If 
    End If 
    '*** Fehlerbehandlung 
    Err.Clear 
Fehler: 
    Application.EnableEvents = True 
    Application.DisplayAlerts = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
End Sub 
 

LG UweD


  

Betrifft: AW: Prima! Danke für die Rückmeldung. owT von: Philip
Geschrieben am: 24.01.2019 11:13:27

Super vielen Dank :)

Ich habe noch eine Sache die ich gerne drin haben würde. auf dem Blatt was kopiert wird sollen die zeilen B19-O19, B39-O39, B59-O59 B79-O79 überwacht werden. Wenn der Wert Kleiner 10 ist soll auf der Mech Mappe der Name oder Hintergrund Rot gefärbt werden (der Name ist ja gleich des Tabellennamens)

Und wenn ich im Blatt Wm auch Namen eintrage muss ich ja vermeiden das der hier ein Name Doppelt erscheint erscheint


Wie kriege ich dort die Sheets MECH Wm IM MAf EBT rein?

Dim Bereich As Range
    Dim Name As String
    Name = Bedienfeld_MECH.TextBox_Nachname

    Dim Letzte As Long
    If [D65536] = "" Then
        Letzte = [D65536].End(xlUp).Row
    Else
        Letzte = 65536
    End If
    Set Bereich = Sheets("MECH").Range("b8:B" & Letzte) _
        .Find(Bedienfeld_MECH.TextBox_Nachname)
    If Bereich Is Nothing Then
'       Keine weiteren AktionenAktion
Wenn du da noch eine lösung für mich hast wäre das Hammer, und wenn nicht trotzdem Hammer, du hast mir super geholfen :)


  

Betrifft: AW: Tabelle löschen wenn Name in Zeile gelöscht wird von: UweD
Geschrieben am: 22.01.2019 17:12:00

Hallo


Zellen Löschen ist kein eigenständiges Event.

evtl. so?

- Rechtsclick auf den Tabellenblattreiter vom "Masterblatt"
- Code anzeigen
- Makro dort reinkopieren

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    Dim TB, Blatt, SP As Integer, TMP As Variant, Neu
    
    '*** Stammdaten Anfang 
    Set TB = Sheets("Master")
    SP = 1 'Überwachte Spalte 
    '*** Stammdaten Ende 
    
    If Not Intersect(Columns(1), Target) Is Nothing Then
        Application.ScreenUpdating = False
        
        'Prüfung ob gelöscht werden kann 
        For Each Blatt In ThisWorkbook.Sheets
            If Blatt.Name <> TB.Name Then 'alle außer Master 
                If WorksheetFunction.CountIf(Columns(SP), Blatt.Name) = 0 Then
                    'Blattname nicht vorhanden 
                    Application.DisplayAlerts = False
                    Blatt.Delete
                    Application.DisplayAlerts = True
                End If
            End If
        Next
        
        'Prüfung auf neuen Eintrag 
        If Target <> "" Then
            On Error Resume Next 'wenn Blatt nicht da, gibts einen Fehler 
            TMP = Sheets(Target.Value).Cells(1, 1).Address
            On Error GoTo Fehler
            If TMP = "" Then 'Gibts noch nicht 
                Set Neu = Sheets.Add(after:=Sheets(Sheets.Count))
                Neu.Name = Target.Value
                TB.Activate
            End If
        End If
    End If
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub


Bei Änderung einer Zelle in Spalte A wird geprüft, ob alle vorhandenen Blattnamen in der Spalte vorhanden sind.
Wenn nicht, wird das Blatt gelöscht


Im Nachgang wird geprüft, ob der gerade geänderte Zelleintrag als Blatt vorhanden ist.
Falls nicht, wird eine neues Blatt diesen Namens angelegt


LG UweD


Beiträge aus dem Excel-Forum zum Thema "Tabelle löschen wenn Name in Zeile gelöscht wird"