Microsoft Excel

Herbers Excel/VBA-Archiv

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

Zellenwert löschen -> Zeile in Tabelle 2 löschen

Betrifft: Zellenwert löschen -> Zeile in Tabelle 2 löschen von: Ro Xi
Geschrieben am: 09.12.2015 15:49:15

Hallo Zusammen,
ich habe eine Frage zu meinem Code.
Wie ist es denn möglich, dass beim Löschen des Eintrags "sb" auch die generierte Zeile in Sheet 3 gelöscht wird?
Kurz zur Erklärung: Wenn ich in Tabelle2 "sb" eintrage werden bestimmte Werte in Sheet 3 erzeugt. Nun soll beim löschen von "sb" der entsprechende Eintrag wieder gelöscht werden!
Geht das? Und wenn ja wie?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 7 And Target.Row > 17 Then
        If LCase(Target) = "sb" Then
            Set wksDst = ActiveWorkbook.Sheets(3)
            lRow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row
                If wksDst.Cells(Rows.Count, 2).End(xlUp).Row = "" Then lRow = 0
                    wksDst.Cells(lRow + 1, 3) = Tabelle2.Cells(Target.Row, 2)
                    wksDst.Cells(lRow + 1, 2) = Tabelle2.Cells(7, Target.Column)
                    wksDst.Cells(lRow + 1, 4) = Tabelle2.Cells(5, Target.Column)   
        End If
    End If
End Sub
Einen schönen Abend wünscht Rixi

  

Betrifft: AW: Zellenwert löschen -> Zeile in Tabelle 2 löschen von: Michael
Geschrieben am: 09.12.2015 17:47:38

Hi Rixi,

offensichtlich werden die neuen Zeilen in Sheet 3 ja unten angehängt, so daß keine direkte Zuordnung von Zeilennummern möglich ist.

D.h., Du mußt erst einmal die richtige Zeile herausfinden. z.B. mit .find und dann evtl. noch einem Vergleich der beiden anderen Werte (innerhalb der Zeile).

Einfacher geht es, wenn Du für beide Tabellen einen "eindeutigen Schlüssel" hast - dann reicht das einfache .find.

Schöne Grüße,

Michael


  

Betrifft: AW: Zellenwert löschen -> Zeile in Tabelle 2 löschen von: Ro Xi
Geschrieben am: 10.12.2015 09:46:04

Hallo Michael,
danke dass du dich meiner angenommen hast :)
Allerdings bin ich eine VBA Neueinsteigerin und komme trotz deiner Hilfe nicht wirklich weiter...
Was meinst du denn mit einem eindeutigen Schlüssel?

Liebe Grüße
Roxi


  

Betrifft: AW: Zellenwert löschen -> Zeile in Tabelle 2 löschen von: Ro Xi
Geschrieben am: 10.12.2015 10:27:51

Hallo nochmal :)
Also soweit habe ich den Code jetzt schon!
Jetzt fehlt eigentlich nur noch, dass statt der Msg Box die Zelle der "Überschneidungen" ausgewählt wird und die dazugehörige Reihe gelöscht wird...
Bin ich auf dem richtigen Weg? Kann mir irgendjemand helfen?

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Finder As String
 Dim Finder1 As String
 Dim Zelle As Range
 Dim Zelle1 As Range
 Finder = Tabelle1.Cells(Target.Row, 1).Value
 Finder1 = Tabelle1.Cells(1, Target.Column)
                If Target.Column > 1 And Target.Row > 2 Then
                    If LCase(Target) = "sb" Then
                     Set wksDst = ActiveWorkbook.Sheets(2)
                        lRow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row
                            If wksDst.Cells(Rows.Count, 2).End(xlUp).Row = "" Then lRow = 0
                                wksDst.Cells(lRow + 1, 2) = Tabelle1.Cells(Target.Row, 1)
                                wksDst.Cells(lRow + 1, 1) = Tabelle1.Cells(1, Target.Column)
                                wksDst.Cells(lRow + 1, 3) = Tabelle1.Cells(2, Target.Column)
                        Else
                        Set Zelle = Tabelle2.Columns(2).Find(Finder)
                        If Not Zelle Is Nothing Then
                        Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
                        If Not Zelle1 Is Nothing Then
                        MsgBox ("Hallo")
                        End If
                        End If
                    End If
                End If
                
    End Sub
Gruß von der langsam verzweifelten Roxi


  

Betrifft: AW: Zellenwert löschen -> Zeile in Tabelle 2 löschen von: Michael
Geschrieben am: 10.12.2015 14:37:09

Hallo Roxi,

ich muß gleich wieder weg vom Rechner; kannst Du mal bitte ne Beispieldatei hochladen, damit ich sehe, mit was für einer Art von Werten Du hantierst?

Vielleicht komme ich später nochmal rein, vielleicht nimmt sich bis dahin auch jemand anderes Deines Problems an.

Schöne Grüße,

Michael


  

Betrifft: AW: Zellenwert löschen -> Zeile in Tabelle 2 löschen von: Ro Xi
Geschrieben am: 10.12.2015 15:16:01

Hallo Michael,

schön dass du dich kümmerst :)
Also mit dem Code bin ich tatsächlich nochmal ein Stück weitergekommen, aber ganz ideal ist er noch immer nicht...
Folgendes Problem liegt noch vor: Wenn ich mehrere sb Werte markiere und diese löschen möchte erscheint eine Fehlermeldung (Laufzeitfehler 13 Typen unverträglich). Beim Löschvorgang von einzelnen sb Werten funktioniert allerdings alles reibungslos :o
Ich freue mich natürlich über jede Hilfe!
Hier noch eine Beispieldatei.
https://www.herber.de/bbs/user/102164.xlsm

Eure Roxi


  

Betrifft: Bitte zu probieren von: Michael
Geschrieben am: 10.12.2015 16:42:41

Hi Roxi,

ich habe mal option explicit darübergeschrieben, damit man gezwungen ist, die Variablen sauber zu deklarieren. Gefehlt hatten lrow und wksDst.

Target kann auch mehrere Zellen umfassen: dann ist target.count >1. Die MsgBox kanns Du ja auskommentieren.

Ich habe eine zusätzlich Range Tz als einzelne Zelle innerhalb des Targets definiert und gehe damit alle in Target enthaltene Zellen in einer For Each-Schleife durch. Damit ist es egal, ob nur eine oder mehrere Zellen markiert wurden.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Finder As String
 Dim Finder1 As String
 Dim Zelle As Range
 Dim Zelle1 As Range
 Dim Zelle2 As Range
 Dim wksDst As Worksheet
 Dim lrow As Long
 Dim Tz As Range ' TargetZellen
 If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
 
 For Each Tz In Target
    Finder = Tabelle1.Cells(Tz.Row, 1).Value
    Finder1 = Tabelle1.Cells(1, Tz.Column)
    If Target.Column > 1 And Tz.Row > 2 Then
        If LCase(Tz.Value) = "sb" Then
              Set wksDst = ActiveWorkbook.Sheets(2)
              lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row
              If wksDst.Cells(Rows.Count, 2).End(xlUp).Row = "" Then lrow = 0
                 ' ="" kann nicht sein, denn .Row gibt IMMMER eine Zahl zurück!    
                 wksDst.Cells(lrow + 1, 2) = Tabelle1.Cells(Tz.Row, 1)
                 wksDst.Cells(lrow + 1, 1) = Tabelle1.Cells(1, Tz.Column)
                 wksDst.Cells(lrow + 1, 3) = Tabelle1.Cells(2, Tz.Column)
                Else
                 Set Zelle = Tabelle2.Columns(2).Find(Finder)
                 If Not Zelle Is Nothing Then
                   Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
                   If Not Zelle1 Is Nothing Then
                     If Zelle.Row = Zelle1.Row Then
                     Zelle1.EntireRow.Delete
                     MsgBox ("Die entsprechende Zeile in Tabelle2 wurde gelöscht.")
                   End If
                 End If
              End If
        End If
    End If
Next
End Sub
Schöne Grüße,

Michael

P.S.: Der Code kann nicht richtig laufen, wenn mehrere Zellen untereinander stehen; ich schau noch mal drüber.


  

Betrifft: AW: Bitte zu probieren von: Ro Xi
Geschrieben am: 10.12.2015 17:07:16

Hi Michael,

super du bist mein Held des Tages :D
Funktioniert soweit ja einwandfrei!
Nur wenn sich Einträge in der selben Spalte bzw Zeile befinden funktioniert es halt noch nicht...
Aber das hast du ja selbst sofort erkannt ;)
Woran liegt das denn? (Muss das ein bisschen hinterfragen, möchte ja auch irgendwann einmal VBA Spezialistin sein :))

Einen schönen Abend wünsche ich dir noch!
Liebe Grüße,
Roxi


  

Betrifft: AW: Bitte zu probieren von: Michael
Geschrieben am: 10.12.2015 17:27:30

Hi Roxi,

das liegt an der Suche. Schau Dir mal diese Werte an:



So wie es jetzt programmiert ist, wird zuerst in der mittleren Spalte gesucht, dann in der linken, und hinterher vergleichst Du, ob beides mit den jeweiligen Werte aus Tabelle1 übereinstimmt.

Nur: gefunden wird der jeweils erste Treffer. Suchst Du z.B. nach "wer12" und "wo2", wird das erste "wer12" in Zeile 2 gefunden, das erste "wo2" aber in Zeile 3.

Abhilfe folgt hier:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Finder As String
 Dim Finder1 As String
 Dim erste As String
 Dim Zelle As Range
 Dim Zelle1 As Range
 Dim Zelle2 As Range
 Dim wksDst As Worksheet
 Dim lrow As Long
 Dim raus As Boolean
 Dim Tz As Range ' TargetZellen
 If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
 
 For Each Tz In Target
    Finder = Tabelle1.Cells(Tz.Row, 1).Value
    Finder1 = Tabelle1.Cells(1, Tz.Column)
    If Target.Column > 1 And Tz.Row > 2 Then
      Set wksDst = ActiveWorkbook.Sheets(2)
      If LCase(Tz.Value) = "sb" Then
         lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
         wksDst.Cells(lrow, 2) = Tabelle1.Cells(Tz.Row, 1)
         wksDst.Cells(lrow, 1) = Tabelle1.Cells(1, Tz.Column)
         wksDst.Cells(lrow, 3) = Tabelle1.Cells(2, Tz.Column)
        Else
         Set Zelle = wksDst.Columns(2).Find(Finder)
         If Not Zelle Is Nothing Then
            erste = Zelle.Address
            raus = False
            While Zelle.Offset(0, -1) <> Finder1 And Not raus
              Set Zelle = wksDst.Columns(2).FindNext(Zelle)
              If erste = Zelle.Address Then raus = True
            Wend
            If Not raus Then
              Zelle.EntireRow.Delete
              MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
            End If
'           Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
'           If Not Zelle1 Is Nothing Then
'             If Zelle.Row = Zelle1.Row Then
'             Zelle1.EntireRow.Delete
'             MsgBox ("Die entsprechende Zeile in Tabelle2 wurde gelöscht.")
'           End If
         End If
      End If
    End If
Next
End Sub

Es wird solange in der mittleren Spalte gesucht, bis der Wert links daneben (das ist das offset(0,-1)) übereinstimmt.

Happy Exceling & liebe Grüße zurück,

Michael


  

Betrifft: AW: Bitte zu probieren von: Michael
Geschrieben am: 10.12.2015 17:28:58

Hi Roxi,

das liegt an der Suche. Schau Dir mal diese Werte an:



So wie es jetzt programmiert ist, wird zuerst in der mittleren Spalte gesucht, dann in der linken, und hinterher vergleichst Du, ob beides mit den jeweiligen Werte aus Tabelle1 übereinstimmt.

Nur: gefunden wird der jeweils erste Treffer. Suchst Du z.B. nach "wer12" und "wo2", wird das erste "wer12" in Zeile 2 gefunden, das erste "wo2" aber in Zeile 3.

Abhilfe folgt hier:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Finder As String
 Dim Finder1 As String
 Dim erste As String
 Dim Zelle As Range
 Dim Zelle1 As Range
 Dim Zelle2 As Range
 Dim wksDst As Worksheet
 Dim lrow As Long
 Dim raus As Boolean
 Dim Tz As Range ' TargetZellen
 If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
 
 For Each Tz In Target
    Finder = Tabelle1.Cells(Tz.Row, 1).Value
    Finder1 = Tabelle1.Cells(1, Tz.Column)
    If Target.Column > 1 And Tz.Row > 2 Then
      Set wksDst = ActiveWorkbook.Sheets(2)
      If LCase(Tz.Value) = "sb" Then
         lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
         wksDst.Cells(lrow, 2) = Tabelle1.Cells(Tz.Row, 1)
         wksDst.Cells(lrow, 1) = Tabelle1.Cells(1, Tz.Column)
         wksDst.Cells(lrow, 3) = Tabelle1.Cells(2, Tz.Column)
        Else
         Set Zelle = wksDst.Columns(2).Find(Finder)
         If Not Zelle Is Nothing Then
            erste = Zelle.Address
            raus = False
            While Zelle.Offset(0, -1) <> Finder1 And Not raus
              Set Zelle = wksDst.Columns(2).FindNext(Zelle)
              If erste = Zelle.Address Then raus = True
            Wend
            If Not raus Then
              Zelle.EntireRow.Delete
              MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
            End If
'           Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
'           If Not Zelle1 Is Nothing Then
'             If Zelle.Row = Zelle1.Row Then
'             Zelle1.EntireRow.Delete
'             MsgBox ("Die entsprechende Zeile in Tabelle2 wurde gelöscht.")
'           End If
         End If
      End If
    End If
Next
End Sub

Es wird solange in der mittleren Spalte gesucht, bis der Wert links daneben (das ist das offset(0,-1)) übereinstimmt.

Happy Exceling & liebe Grüße zurück,

Michael


  

Betrifft: AW: Bitte zu probieren von: Michael
Geschrieben am: 10.12.2015 17:29:51

Hi Roxi,

das liegt an der Suche. Schau Dir mal diese Werte an:



So wie es jetzt programmiert ist, wird zuerst in der mittleren Spalte gesucht, dann in der linken, und hinterher vergleichst Du, ob beides mit den jeweiligen Werte aus Tabelle1 übereinstimmt.

Nur: gefunden wird der jeweils erste Treffer. Suchst Du z.B. nach "wer12" und "wo2", wird das erste "wer12" in Zeile 2 gefunden, das erste "wo2" aber in Zeile 3.

Abhilfe folgt hier:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Finder As String
 Dim Finder1 As String
 Dim erste As String
 Dim Zelle As Range
 Dim Zelle1 As Range
 Dim Zelle2 As Range
 Dim wksDst As Worksheet
 Dim lrow As Long
 Dim raus As Boolean
 Dim Tz As Range ' TargetZellen
 If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
 
 For Each Tz In Target
    Finder = Tabelle1.Cells(Tz.Row, 1).Value
    Finder1 = Tabelle1.Cells(1, Tz.Column)
    If Target.Column > 1 And Tz.Row > 2 Then
      Set wksDst = ActiveWorkbook.Sheets(2)
      If LCase(Tz.Value) = "sb" Then
         lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
         wksDst.Cells(lrow, 2) = Tabelle1.Cells(Tz.Row, 1)
         wksDst.Cells(lrow, 1) = Tabelle1.Cells(1, Tz.Column)
         wksDst.Cells(lrow, 3) = Tabelle1.Cells(2, Tz.Column)
        Else
         Set Zelle = wksDst.Columns(2).Find(Finder)
         If Not Zelle Is Nothing Then
            erste = Zelle.Address
            raus = False
            While Zelle.Offset(0, -1) <> Finder1 And Not raus
              Set Zelle = wksDst.Columns(2).FindNext(Zelle)
              If erste = Zelle.Address Then raus = True
            Wend
            If Not raus Then
              Zelle.EntireRow.Delete
              MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
            End If
'           Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
'           If Not Zelle1 Is Nothing Then
'             If Zelle.Row = Zelle1.Row Then
'             Zelle1.EntireRow.Delete
'             MsgBox ("Die entsprechende Zeile in Tabelle2 wurde gelöscht.")
'           End If
         End If
      End If
    End If
Next
End Sub

Es wird solange in der mittleren Spalte gesucht, bis der Wert links daneben (das ist das offset(0,-1)) übereinstimmt.

Happy Exceling & liebe Grüße zurück,

Michael


  

Betrifft: AW: Bitte zu probieren von: Michael
Geschrieben am: 10.12.2015 17:30:50

Hi Roxi,

das liegt an der Suche. Schau Dir mal diese Werte an:



So wie es jetzt programmiert ist, wird zuerst in der mittleren Spalte gesucht, dann in der linken, und hinterher vergleichst Du, ob beides mit den jeweiligen Werte aus Tabelle1 übereinstimmt.

Nur: gefunden wird der jeweils erste Treffer. Suchst Du z.B. nach "wer12" und "wo2", wird das erste "wer12" in Zeile 2 gefunden, das erste "wo2" aber in Zeile 3.

Abhilfe folgt hier:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Finder As String
 Dim Finder1 As String
 Dim erste As String
 Dim Zelle As Range
 Dim Zelle1 As Range
 Dim Zelle2 As Range
 Dim wksDst As Worksheet
 Dim lrow As Long
 Dim raus As Boolean
 Dim Tz As Range ' TargetZellen
 If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
 
 For Each Tz In Target
    Finder = Tabelle1.Cells(Tz.Row, 1).Value
    Finder1 = Tabelle1.Cells(1, Tz.Column)
    If Target.Column > 1 And Tz.Row > 2 Then
      Set wksDst = ActiveWorkbook.Sheets(2)
      If LCase(Tz.Value) = "sb" Then
         lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
         wksDst.Cells(lrow, 2) = Tabelle1.Cells(Tz.Row, 1)
         wksDst.Cells(lrow, 1) = Tabelle1.Cells(1, Tz.Column)
         wksDst.Cells(lrow, 3) = Tabelle1.Cells(2, Tz.Column)
        Else
         Set Zelle = wksDst.Columns(2).Find(Finder)
         If Not Zelle Is Nothing Then
            erste = Zelle.Address
            raus = False
            While Zelle.Offset(0, -1) <> Finder1 And Not raus
              Set Zelle = wksDst.Columns(2).FindNext(Zelle)
              If erste = Zelle.Address Then raus = True
            Wend
            If Not raus Then
              Zelle.EntireRow.Delete
              MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
            End If
'           Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
'           If Not Zelle1 Is Nothing Then
'             If Zelle.Row = Zelle1.Row Then
'             Zelle1.EntireRow.Delete
'             MsgBox ("Die entsprechende Zeile in Tabelle2 wurde gelöscht.")
'           End If
         End If
      End If
    End If
Next
End Sub

Es wird solange in der mittleren Spalte gesucht, bis der Wert links daneben (das ist das offset(0,-1)) übereinstimmt.

Happy Exceling & liebe Grüße zurück,

Michael


  

Betrifft: AW: Bitte zu probieren von: Ro Xi
Geschrieben am: 11.12.2015 08:23:05

Hi Michael,

tausend Dank!!!
Bin super happy mit deiner Lösung :)Funktioniert alles einwandfrei.
Danke auch für deine tolle Erklärung.

Liebe Grüße,
Roxi


  

Betrifft: AW: Bitte zu probieren von: Michael
Geschrieben am: 10.12.2015 17:34:17

Hi Roxi,

das liegt an der Suche. Schau Dir mal diese Werte an:



So wie es jetzt programmiert ist, wird zuerst in der mittleren Spalte gesucht, dann in der linken, und hinterher vergleichst Du, ob beides mit den jeweiligen Werte aus Tabelle1 übereinstimmt.

Nur: gefunden wird der jeweils erste Treffer. Suchst Du z.B. nach "wer12" und "wo2", wird das erste "wer12" in Zeile 2 gefunden, das erste "wo2" aber in Zeile 3.

Abhilfe folgt hier:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Finder As String
 Dim Finder1 As String
 Dim erste As String
 Dim Zelle As Range
 Dim Zelle1 As Range
 Dim Zelle2 As Range
 Dim wksDst As Worksheet
 Dim lrow As Long
 Dim raus As Boolean
 Dim Tz As Range ' TargetZellen
 If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
 
 For Each Tz In Target
    Finder = Tabelle1.Cells(Tz.Row, 1).Value
    Finder1 = Tabelle1.Cells(1, Tz.Column)
    If Target.Column > 1 And Tz.Row > 2 Then
      Set wksDst = ActiveWorkbook.Sheets(2)
      If LCase(Tz.Value) = "sb" Then
         lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
         wksDst.Cells(lrow, 2) = Tabelle1.Cells(Tz.Row, 1)
         wksDst.Cells(lrow, 1) = Tabelle1.Cells(1, Tz.Column)
         wksDst.Cells(lrow, 3) = Tabelle1.Cells(2, Tz.Column)
        Else
         Set Zelle = wksDst.Columns(2).Find(Finder)
         If Not Zelle Is Nothing Then
            erste = Zelle.Address
            raus = False
            While Zelle.Offset(0, -1) <> Finder1 And Not raus
              Set Zelle = wksDst.Columns(2).FindNext(Zelle)
              If erste = Zelle.Address Then raus = True
            Wend
            If Not raus Then
              Zelle.EntireRow.Delete
              MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
            End If
'           Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
'           If Not Zelle1 Is Nothing Then
'             If Zelle.Row = Zelle1.Row Then
'             Zelle1.EntireRow.Delete
'             MsgBox ("Die entsprechende Zeile in Tabelle2 wurde gelöscht.")
'           End If
         End If
      End If
    End If
Next
End Sub

Es wird solange in der mittleren Spalte gesucht, bis der Wert links daneben (das ist das offset(0,-1)) übereinstimmt.

Happy Exceling & liebe Grüße zurück,

Michael


  

Betrifft: AW: Bitte zu probieren von: Ro Xi
Geschrieben am: 11.12.2015 11:19:13

Hallo Michael,

jetzt hab ich tatsächlich noch ein mini kleines Problem entdeckt...
Leider ist mir das ganze erst im Praxistest aufgefallen :(
Wenn ich sb mit anderen Werten überschriebe, reagiert das Makro als würde ich sb löschen.
Bei den Buchstabenkombinationen Eb, Ü und V soll das allerdings nicht passieren.

Kannst du dich ein letztes mal erbarmen und mir eine kurze Hilfestellung geben?

Danke dir schon mal im vorraus!

Beste Grüße,
Roxi


  

Betrifft: Ist es dann nicht so, von: Michael
Geschrieben am: 11.12.2015 16:39:21

Hallo Roxi,

daß Du evtl. auch die Werte übernommen haben möchtest, wenn z.B. Ü eingegeben wird?

  • Private Sub Worksheet_Change(ByVal Target As Range)
     Dim Finder As String
     Dim Finder1 As String
     Dim erste As String
     Dim Zelle As Range
     Dim Zelle1 As Range
     Dim Zelle2 As Range
     Dim wksDst As Worksheet
     Dim lrow As Long
     Dim raus As Boolean
     Dim Tz As Range ' TargetZellen
     Const nichtwenn = ",ü,eb,v," ' ***************** Konstante
     
     If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
     
     For Each Tz In Target
        Finder = Tabelle1.Cells(Tz.Row, 1).Value
        Finder1 = Tabelle1.Cells(1, Tz.Column)
        If Target.Column > 1 And Tz.Row > 2 Then
          Set wksDst = ActiveWorkbook.Sheets(2)
          If LCase(Tz.Value) = "sb" Then
             lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
             wksDst.Cells(lrow, 2) = Tabelle1.Cells(Tz.Row, 1)
             wksDst.Cells(lrow, 1) = Tabelle1.Cells(1, Tz.Column)
             wksDst.Cells(lrow, 3) = Tabelle1.Cells(2, Tz.Column)
           Else
    ' Hier prüfe ich, ob die Zelle leer ist oder, wenn nicht, ob der Wert
    ' in der Konstante Const nichtwenn (siehe oben) enthalten ist.
    ' Im Prinzip kann man sich die erste Bedingung nach dem OR schenken,
    ' weil diese logischen Operatoren von links nach rechts ausgewertet werden,
    ' bis das Ergebnis klar ist; d.h. wenn die Zelle leer ist, ist die IF-Abfrage
    ' WAHR und der Rest wird ignoriert.
    ' Trotzdem habe ich das LCase(Tz.Value) <> "" stehen lassen, denn Instr(text,"")
    ' mit Leerstring ist >0, und das wollen wir nicht.
    
            If LCase(Tz.Value) = "" Or (LCase(Tz.Value) <> "" And InStr(nichtwenn, _
               "," & LCase(Tz.Value) & ",") = 0) Then
             Set Zelle = wksDst.Columns(2).Find(Finder)
             If Not Zelle Is Nothing Then
                erste = Zelle.Address
                raus = False
                While Zelle.Offset(0, -1) <> Finder1 And Not raus
                  Set Zelle = wksDst.Columns(2).FindNext(Zelle)
                  If erste = Zelle.Address Then raus = True
                Wend
                If Not raus Then
                  Zelle.EntireRow.Delete
                  MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
                End If
    '           Set Zelle1 = Tabelle2.Columns(1).Find(Finder1)
    '           If Not Zelle1 Is Nothing Then
    '             If Zelle.Row = Zelle1.Row Then
    '             Zelle1.EntireRow.Delete
    '             MsgBox ("Die entsprechende Zeile in Tabelle2 wurde gelöscht.")
    '           End If
             End If
            End If
          End If
        End If
    Next
    End Sub


  • Falls ja, leg Dir am besten ne zweite Konstante als String an...

    Die ganze Geschichte sieht ein bißchen nach Code-Wildwuchs aus; ich würde sie gerne etwas straffen - andererseits, wenn es so funktioniert und keine Geschwindigkeitsprobleme macht, wozu Arbeit reinstecken?

    Schöne Grüße,

    Michael

    P.S.: mir fällt gerade auf, daß bein Überschreiben eines sb mit sb eine weitere Zeile mit diesen Werten angelegt wird; das ist, denke ich, auch nicht erwünscht - also überleg Dir mal, ob Du das vom ersten Satz (dieser Nachricht) noch eingebaut haben willst, dann machen wir das in einem Rutsch.


      

    Betrifft: AW: Ist es dann nicht so, von: Ro Xi
    Geschrieben am: 11.12.2015 17:11:11

    Hallo Michael,

    super nett wie du dich kümmerst :)
    Also es ist so, dass sb immer der erste Wert sein wird!
    Nach einiger ZEit wird dieses dann mit ü eb etc überschrieben. Diese Überschreibung soll allerdings keine Löschung der Zeileneinträge hervorrufen, sondern keinerlei Einfluss haben.

    If Target.Cells <> "ü" And Target.Cells <> "Ü" And Target.Cells <> "eb" And Target.Cells <> "Eb" And Target.Cells <> "eB" And Target.Cells <> "v" And Target.Cells <> "EB" And Target.Cells <> "V" Then 

    Diese Zeile habe ich jetzt noch eingefügt geht irgendwie aber es ist einfach nicht ganz ideal und spinnt manchmal beim läschen von mehreren Zelln gleichzeitig...
    Und beim Überschreiben von sb mit sb soll am besten keine neue Zeile generiert werden. Das hast du richtig erkannt :o Das ist mir selber noch gar nicht aufgefallen :D
    Was die Profis immer alles sehen ;)


    Liebe Grüße,
    Roxi


      

    Betrifft: verstehe ich jetzt nicht, von: Michael
    Geschrieben am: 11.12.2015 19:26:21

    Roxi,

    denn genau das habe ich doch mit der Konstante und dem Instr erledigt:

    Const nichtwenn = ",ü,eb,v,"
    ...
    InStr(nichtwenn, "," & LCase(Tz.Value) & ",") = 0
    
    Du brauchst dann nur oben die Konstante ändern, falls sich mal was an ü,v oder eb was ändert, und durch das LCase wird die Kleinschreibung verglichen - das hattest Du doch beim Vergleich mit sb schon selbst verwendet.

    Das, was ich Dir zuletzt gepostet habe, müßte doch *ohne Änderung* genau so (bis auf mehrfaches sb) funktionieren, wie Du es willst. Deshalb verstehe ich nicht, warum Du da noch Code einfügst.

    Schöne Grüße,

    Michael


      

    Betrifft: so, ohne doppelte "sb"-Zeilen von: Michael
    Geschrieben am: 11.12.2015 20:26:12

    Hi Roxi,

    ich habe das mit den mehrfache "sb"-Zeilen noch geändert, jetzt sollte es passen:

    Private Sub Worksheet_Change(ByVal Target As Range)
    ' "mit ohne" doppelte "sb"
     Dim Finder As String
     Dim Finder1 As String
     Dim erste As String
     Dim Zelle As Range
     Dim Zelle1 As Range
     Dim Zelle2 As Range
     Dim wksDst As Worksheet
     Dim lrow As Long
     Dim raus As Boolean
     Dim letzter As Variant
     Dim Tz As Range ' TargetZellen
     Const nichtwenn = ",ü,eb,v,"
     
     If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
     
     For Each Tz In Target
       If Target.Column > 1 And Tz.Row > 2 Then
          Finder = Tabelle1.Cells(Tz.Row, 1).Value
          Finder1 = Tabelle1.Cells(1, Tz.Column)
          Set wksDst = ActiveWorkbook.Sheets(2)
          If Trim(LCase(Tz.Value)) = "sb" Then
    ' Recherche: excel vba worksheet_change letzter wert
             letzter = Trim(LCase(Tz.Value))
             Application.EnableEvents = False
             Application.Undo
    '         MsgBox "letzer: " & letzter & " tz " & Tz.Value
             If Trim(LCase(Tz.Value)) = "sb" Then
                Application.EnableEvents = True
               Else
                Tz.Value = "sb"    ' erneut setzen
                Application.EnableEvents = True
                lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
                wksDst.Cells(lrow, 2) = Tabelle1.Cells(Tz.Row, 1)
                wksDst.Cells(lrow, 1) = Tabelle1.Cells(1, Tz.Column)
                wksDst.Cells(lrow, 3) = Tabelle1.Cells(2, Tz.Column)
              End If
           Else
            If LCase(Tz.Value) = "" Or (LCase(Tz.Value) <> "" And InStr(nichtwenn, _
               "," & LCase(Tz.Value) & ",") = 0) Then
             Set Zelle = wksDst.Columns(2).Find(Finder)
             If Not Zelle Is Nothing Then
                erste = Zelle.Address
                raus = False
                While Zelle.Offset(0, -1) <> Finder1 And Not raus
                  Set Zelle = wksDst.Columns(2).FindNext(Zelle)
                  If erste = Zelle.Address Then raus = True
                Wend
                If Not raus Then
                  Zelle.EntireRow.Delete
                  MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
                End If
             End If
            End If
          End If
       End If           ' Target.Column > 1 And Tz.Row > 2 Then
    Next
    End Sub
    
    Liebe Grüße,

    Michael


      

    Betrifft: Funktioniert es? von: Michael
    Geschrieben am: 13.12.2015 18:24:30

    Hi Roxi,

    hast Du die letzte Version getestet?

    LG,

    Michael


      

    Betrifft: AW: Funktioniert es? von: Ro Xi
    Geschrieben am: 14.12.2015 09:59:40

    Hallo Michael du VBA Gott :D ,
    hatte am Wochenende leider viel zu tun und kam nicht zum VBA Code testen...
    Code funktioniert im Testumfeld super gut! Du bist einfach ein echter Experte :)
    Ich weiß gar nicht wie ich dir dafür Danken kann :o
    Allerdings bekomme ich beim Implementieren in den "Komplettcode" immer eine Fehlermeldung in der Zeile Application.Undo....
    Ich weiß langsam echt nicht mehr ob ich es jemals schaffen werde den Code ganz zum laufen zu bringen :(
    Vllt kannst du mir ja ein letztes Mal helfen!

      Private Sub Worksheet_Change(ByVal Target As Range)
        
            Dim einzelZelle As Range
            Dim dasDatum As Variant
            Dim Aussteigen As Boolean
                  
            For Each einzelZelle In Target.Cells
                Aussteigen = False
                If Target.Column > 7 And Target.Row > 17 Then
                    If UCase(einzelZelle.Text) = "V" Then
                        Do
                            dasDatum = InputBox("Bitte geben Sie das Datum der abgeschlossenen  _
    Wirksamkeitsprüfung ein." & vbCrLf & "Das Datum muss mit dem Datum im Schulungsprotokoll übereinstimmen.", "Datumsabfrage", Format(Date, "DD.MM.YYYY"))
                            If dasDatum = "" Then
                                Aussteigen = MsgBox("Wollen Sie den Eintrag abbrechen? Das V wird  _
    in diesem Fall gelöscht.", vbYesNo) = vbYes
                            End If
                        Loop Until IsDate(dasDatum) Or Aussteigen
                        If Aussteigen Then
                            Application.EnableEvents = False
                                einzelZelle.ClearContents
                            Application.EnableEvents = True
                        Else
                            Tabelle7.Cells(einzelZelle.Row, einzelZelle.Column) = CDate(dasDatum)
                        MsgBox "Das Datum wurde im Schulungskalender hinterlegt."
                        End If
                    Else
                        Tabelle7.Cells(einzelZelle.Row, einzelZelle.Column).ClearContents
                        If InStr(1, UCase("ebsbü"), UCase(einzelZelle.Text)) = 0 Then MsgBox "Das  _
    zugehörige Datum im Schulungskalender wurde gelöscht."
                    End If
                End If
            Next einzelZelle
            
    ' "mit ohne" doppelte "sb"
     Dim Finder As String
     Dim Finder1 As String
     Dim erste As String
     Dim Zelle As Range
     Dim Zelle1 As Range
     Dim Zelle2 As Range
     Dim wksDst As Worksheet
     Dim lrow As Long
     Dim raus As Boolean
     Dim letzter As Variant
     Dim Tz As Range ' TargetZellen
     Const nichtwenn = ",ü,eb,v,"
     
     If Target.Count > 1 Then MsgBox "mehrere Zellen markiert"
     
     For Each Tz In Target
       If Target.Column > 7 And Tz.Row > 17 Then
          Finder = Tabelle2.Cells(Tz.Row, 2).Value
          Finder1 = Tabelle2.Cells(7, Tz.Column)
          Set wksDst = ActiveWorkbook.Sheets(4)
          If Trim(LCase(Tz.Value)) = "sb" Then
    ' Recherche: excel vba worksheet_change letzter wert
             letzter = Trim(LCase(Tz.Value))
             Application.EnableEvents = False
             Application.Undo
    '         MsgBox "letzer: " & letzter & " tz " & Tz.Value
             If Trim(LCase(Tz.Value)) = "sb" Then
                Application.EnableEvents = True
               Else
                Tz.Value = "sb"    ' erneut setzen
                Application.EnableEvents = True
                lrow = wksDst.Cells(Rows.Count, 2).End(xlUp).Row + 1
                wksDst.Cells(lrow, 3) = Tabelle2.Cells(Tz.Row, 2)
                wksDst.Cells(lrow, 2) = Tabelle2.Cells(7, Tz.Column)
                wksDst.Cells(lrow, 4) = Tabelle2.Cells(5, Tz.Column)
              End If
           Else
            If LCase(Tz.Value) = "" Or (LCase(Tz.Value) <> "" And InStr(nichtwenn, _
               "," & LCase(Tz.Value) & ",") = 0) Then
             Set Zelle = wksDst.Columns(3).Find(Finder)
             If Not Zelle Is Nothing Then
                erste = Zelle.Address
                raus = False
                While Zelle.Offset(0, -1) <> Finder1 And Not raus
                  Set Zelle = wksDst.Columns(3).FindNext(Zelle)
                  If erste = Zelle.Address Then raus = True
                Wend
                If Not raus Then
                  Zelle.EntireRow.Delete
                  MsgBox ("Die Zeile in Tabelle2 wurde gelöscht.")
                End If
             End If
            End If
          End If
       End If           ' Target.Column > 1 And Tz.Row > 2 Then
    Next
                    
                    
        End Sub 
    Und das mit dem LCase hat das letzte mal einfach nicht richtig funktioniert, deswegn habe ich gedacht ich schreibe diese Zeile anders.

    Hoffentlich hast du noch etwas Geduld mit mir....


    Ganz liebe Grüße von der Roxi


     

    Beiträge aus den Excel-Beispielen zum Thema "Zellenwert löschen -> Zeile in Tabelle 2 löschen"