Thema Datum  Von Nutzer Rating
Antwort
31.01.2021 14:13:18 Markus
NotSolved
31.01.2021 21:07:54 AlterDresdner
NotSolved
31.01.2021 21:41:37 Markus
NotSolved
Blau Tabellen nach gleicher Zeile durchsuchen und beide löschen
 01.02.2021 01:12:39 ralf_b
Solved
01.02.2021 12:17:18 AlterDresdner
NotSolved

Ansicht des Beitrags:
Von:
ralf_b		 Datum:
01.02.2021 01:12:39		 Views:
622		 Rating:
     
Antwort:
 Nein
Thema:
Tabellen nach gleicher Zeile durchsuchen und beide löschen		 
die debug.print zeilen dienen der Kontrolle. die kannst du auskommentieren.


Sub ZeilenLoeschen()
  Dim sh1 As Object, sh2 As Object, found, zeile As Long, i As Long, colcnt As Long
  Dim addr1 As String
  
  Set sh1 = ThisWorkbook.Sheets("1")
  Set sh2 = ThisWorkbook.Sheets("2")
  zeile = sh1.Cells(Rows.Count, 1).End(xlUp).Row
  If ActiveCell.Row > zeile Then Exit Sub
  zeile = ActiveCell.Row
  Set found = sh2.Range("A:A").Find(what:=sh1.Cells(zeile, 1), lookat:=xlWhole)
  Debug.Print "sh1 " & found.Address
  If Not found Is Nothing Then
    addr1 = found.Address

    Do
        'prüfung od die Spaltenanzahl gleich ist 
        colcnt = sh1.Cells(zeile, Columns.Count).End(xlToLeft).Column
        If colcnt <> sh2.Cells(found.Row, Columns.Count).End(xlToLeft).Column Then Exit Do
       
        'prüfen der Zellinhalte in den zeilen     
        For i = 1 To colcnt
           If sh1.Cells(zeile, i) <> sh2.Cells(found.Row, i) Then Exit For
        Next
        
        'zeilen löschen wenn kein Unterschied gefunden
        If i > colcnt Then
          Debug.Print "sh2 ok " & found.Address
          sh1.Rows(zeile).Delete shift:=xlUp
          sh2.Rows(found.Row).Delete shift:=xlUp
          Exit Sub
        Else
          'weitersuchen wenn Unterschiede in Zeilen vorhanden
          Set found = sh2.Range("A:A").FindNext(found)
          Debug.Print "sh2 not ok " & found.Address
        End If

     Loop While Not found Is Nothing

  End If
End Sub

gruß

rb

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
31.01.2021 14:13:18 Markus
NotSolved
31.01.2021 21:07:54 AlterDresdner
NotSolved
31.01.2021 21:41:37 Markus
NotSolved
Blau Tabellen nach gleicher Zeile durchsuchen und beide löschen
 01.02.2021 01:12:39 ralf_b
Solved
01.02.2021 12:17:18 AlterDresdner
NotSolved