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:
800
Rating: Antwort:
 Nein
Thema:
Tabellen nach gleicher Zeile durchsuchen und beide löschen
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
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