Zeile löschen durch VBA

[joshua]

Hallo Community!

Ich stehe momentan vor der Herausforderung, meine Prozeduren durch Operatoren (&) zu erweitern.
Die Grundform meiner gewünschten Prozedur kann ich bereits von anderen übernehmen, weiß nun nicht, wie ich diese jedoch erweitern kann.

Ziel ist:
Lösche Zeile 2, wenn in J2 "Exit", jedoch nur, wenn die da drunter liegende Zeile (J3) leer ist.

Wie erweitere ich nun mein Sub?

Code:

Sub Delete()

  Dim Zeile As Long
  Dim ZeileMax As Long
  Dim Text As Variant
 
      With tblTest
     
          Text = "Exit"
          ZeileMax = .UsedRange.Rows.Count
         
              For Zeile = 2 To ZeileMax
                 
                 If InStr(1, .Range("J" & Zeile).Value, Text, 1) = 1 Then


                 End If
                 
              Next Zeile
                                                                                           
      End With

[Steffl]

Hallo,

löschen musst Du von unten nach oben. Ohne jetzt deine Struktur zu ändern (ginge mit der Find-Methode wahrscheinlich schneller) versuche es mal so

PHP-Code:

Sub prcDelete()

   Dim Zeile As Long
   Dim ZeileMax As Long
   Dim strText As String   'Variant
   
       With tblTest
       
           strText = "Exit"
           ZeileMax = .UsedRange.Rows.Count
           
               For Zeile = ZeileMax To 2 Step -1
                  
                  If InStr(1, .Range("J" & Zeile).Value, strText, 1) = 1 And IsEmpty(.Range("J" & Zeile + 1)) Then
                      .Rows(Zeile).Delete

                  End If
                  
               Next Zeile
                                                                                             
       End With
End Sub 


[joshua]

Ich bedanke mich!

[joshua]

Hallo,

löschen musst Du von unten nach oben. Ohne jetzt deine Struktur zu ändern (ginge mit der Find-Methode wahrscheinlich schneller) versuche es mal so

PHP-Code:

Sub prcDelete()

   Dim Zeile As Long
   Dim ZeileMax As Long
   Dim strText As String   'Variant
   
       With tblTest
       
           strText = "Exit"
           ZeileMax = .UsedRange.Rows.Count
           
               For Zeile = ZeileMax To 2 Step -1
                  
                  If InStr(1, .Range("J" & Zeile).Value, strText, 1) = 1 And IsEmpty(.Range("J" & Zeile + 1)) Then
                      .Rows(Zeile).Delete

                  End If
                  
               Next Zeile
                                                                                             
       End With
End Sub 


Hallo Stefl!
Mir ist gerade aufgefallen, dass der Code noch nicht zu 100% funktioniert.
Mit dem Code löscht er leider alle Zeilen, die "Exit" enthalten, auch wenn Exit zwei mal hintereinander vorkommt.
Ich habe mal eine Beispieldatei angehangen.

[atilla]

Hallo,

hier eine anderer Lösungsweg ("Teilabkupfer" von snb)

Code:

Sub ausblenden()
 Dim j As Long, lngZ As Long
 Dim strgZeilen As String
 Dim c00
 Dim suchBegriff
 
 suchBegriff = "Exit"
 
 With Sheets("vorher")
   lngZ = .Cells(Rows.Count, 10).End(xlUp).Row
  For j = 1 To lngZ
    If Application.CountIf(Range(Cells(j, 10), Cells(j + 1, 10)), suchBegriff) = 2 And Cells(j + 2) = "" Then c00 = c00 & ", " & j & ":" & j
  Next j
 
  strgZeilen = RTrim(Mid(Trim(c00), 3))
  If strgZeilen <> "" Then
    Range(strgZeilen).Delete
  Else
    MsgBox "Keine Kombination gefunden!"
  End If
 
 End With

End Sub

[joshua]

Hallo atilla!

Danke für deine Lösung.

Leider funktioniert diese nicht. Ich habe deinen Code in meine Beispieldatei eingefügt und leider passiert fasst nichts.

Habe ich etwas falsch gemacht?

Eine komplette Zeile soll gelöscht werden, wenn in J "Exit" steht und die darunter liegende Zelle in J+1 leer ist. Ist in J+1 wieder ein "Exit" enthalten, so soll nichts passieren bzw. zur nächsten Zeile die Schleife beginnen lassen.




Beste Grüße

[Steffl]

Hallo,

das zweimal hinereinander das Exit stehen kann, war aus dem Eröffnungsbeitrag nicht ersichtlich. Drehe mal die Schleife um (statt aufsteigend absteigend).

Code:

For Zeile = 2 to ZeileMax