Office: (Office 365) VBA Code gesucht für Zeilen löschen anhand von Kriterien

Guten Tag
Ich habe eine Exceldatei mit mehreren Tabellen. Auf einer Tabelle habe ich eine ziemlich grosse Liste von Einträgen, die mit einem bestimmten Schlüssel versehen sind (pro Tag mehrere Einträge für die Stundenerfassung von mehreren Personen auf Projekten (<--Schlüssel).
Auf einer anderen Tabelle habe ich weniger Einträge (knapp 120) mit den Projekten die mich eigentlich interessieren.
Jeden Monat werden ein paar hundert Einträge in der ersten Tabelle eingefügt mit neuen Einträgen, sodass die Liste gegen Ende Jahr ein paar hunderttausend Zeilen umfasst, von denen mich nicht mal ein viertel davon interessiert.
Nun möchte ich ein Makro schreiben, welches mir anhand der Liste auf Tabelle 2 die Zeilen in Tabelle 1 löscht, welche nicht mit einem der Projektschlüssel übereinstimmt.

Ich habe mal folgenden Code zusammen, der mir einfach ein Projekt filtern kann, aber ich finde nicht heraus, wie ich eine Liste von Projektnummern filtern kann.

Option Explicit
Sub ZeileLöschen()
Dim Bereich As Range
Dim i As Long
Set Bereich = Intersect(Range("E:E"), ActiveSheet.UsedRange)
With Bereich
For i = .Count To 1 Step -1
If .Cells(i) = "Projekt 1234" Then .Cells(i).EntireRow.Delete
Next i
End Sub​

Herzlichen Dank und Gruss
TiRohn

 

Hi,

du hast Excel 365 und damit die FILTER()-Funktion.
Tabelle1 sei deine lange Tabelle, Tabelle2 deine Projekte. Beides seien Strg-T-Tabellen, in beiden heißt die Spalte mit den Projektnummern [Projekte].
Mach ein neues Blatt.
In Zeile 1 kommen die Überschriften von [Tabelle1].
A1: =Tabelle1[#Kopfzeilen]
In A2 kommt die Formel
A2: =FILTER(Tabelle1;ZÄHLENWENNS(Tabelle2[Projekte];Tabelle1[Projekte]))
Jetzt hast du immer deine Projekte im Blick.

 

Hallo,

falls du das mit VBA lösen möchtest (Zeilen zu löschen statt zu filtern):
dann gib dem Zellbereich mit den zu löschenden Projektnamen im Namensmanager einen Namen. Im folgenden Makro habe ich dafür den Namen "LöschProjekte" gewählt.

Code:

Option Explicit

Sub ZeileLöschen()
   Dim Bereich As Range
   Dim i As Long
   Dim ListeProjekte As Range
 
   'Benannter Bereich mit zu löschenden Projekten
   Set ListeProjekte = Range("LöschProjekte")
 
   On Error GoTo NichtGefunden
 
   Set Bereich = Intersect(Range("E:E"), ActiveSheet.UsedRange)
   With Bereich
      For i = .Count To 1 Step -1
         'Teste, ob .Cells(i) in Zellbereich "LöschProjekte" enthalten ist:
         'Falls ja:   Führe den Delete-Befehl ist
         'Falls nein: Es wird ein Fehler erzeugt, der bewirkt,
                     'dass nach "NichtGefunden" gesprungen wird
         If WorksheetFunction.Match(.Cells(i).Value, ListeProjekte, 0) Then
            .Cells(i).EntireRow.Delete
         End If
SucheWeiter:
      Next i
   End With
 
   Exit Sub
 
NichtGefunden:
   'Springe von hier wieder zurück in die i-Schleife und teste nächstes i
   Resume SucheWeiter
End Sub