vba zum löschen

[ari-2001]

  Mappe1.xlsx (Größe: 14,88 KB / Downloads: 14) Hallo,

ich habe eine Tabelle, in der 2 Blätter sind.

Blatt 1 = Daten
Blatt 2 = Zusammenfassung


In Blatt 1 stehen in Spalte  A Nummern, die ich brauche
In Blatt 2 stehen in Spalte B ebenfalls Nummern, allerdings auch welche, die ich nicht benötige

Wie muss das Makro aussehen, dass es die Zeile löscht, wenn keiner der Referenzwerte aus der Liste in Blatt 1 steht?

Ich bedanke mich im Voraus für die Unterstützung.

Viele Grüße
Andreas

[volti]

Hallo Andreas,
teste mal das nachfolgende Makro, ob es Deinen Wünschen entspricht.

Option Explicit

Sub ZeilenLoeschen()
'Zeilen löschen, die nicht in der Referenzliste stehen
 Dim oDict As Object, vArr As Variant, WSh As Worksheet
 Dim iRow As Long, sKey As String, sBer As String
 
 Set oDict = CreateObject("Scripting.Dictionary")
'Benötigte Items aus Referenzliste ermitteln
 Set WSh = Sheets("Daten")                      'Referenzblatt
 sBer = "$A$1:$A$" & WSh.Cells(WSh.Rows.Count, "A").End(xlUp).Row
 vArr = WSh.Range(sBer)                         'Eingangsdaten ins Array übertragen
 With oDict
  For iRow = 1 To UBound(vArr)                  'Alle Zeilen durchgehen
    sKey = vArr(iRow, 1)
    If Not .Exists(sKey) Then                   'Item einmalig ins Dictionary
       oDict(sKey) = oDict(sKey) + vArr(iRow, 1)
    End If
  Next iRow
'Abgleich mit Zusammenfassung durchführen
  Set WSh = Sheets("Zusammenfassung")           'Ausgabeblatt
  For iRow = WSh.Cells(WSh.Rows.Count, "B").End(xlUp).Row To 1 Step -1
    If Not .Exists(WSh.Cells(iRow, "B").Value) Then
       Rows(iRow).Delete Shift:=xlUp
    End If
  Next iRow
 End With
End Sub

viele Grüße
Karl-Heinz

[MisterBurns]

@Karl-Heinz: Ist das nicht mit Atombomben auf Amöben schießen?

Code:

Sub Loeschen()
Dim i As Long

For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
    If WorksheetFunction.CountIf(Sheets("Daten").Columns(1), Cells(i, 2)) = 0 Then
        Rows(i).Delete shift:=xlUp
    End If
Next i
End Sub

[Raoul21]

Hallo Andreas,

probier mal:

Code:

Sub Andreas()
    Dim a As Range, b As Range
    Set a = Sheets("Daten").Range("A1:A9")
    'oder
    Set a = Sheets("Daten").Range("A1").CurrentRegion

    With Sheets("Zusammenfassung").Range("A1").CurrentRegion
        For Each b In .Columns(2).Cells
            If Not a.Find(b, lookat:=xlWhole) Is Nothing Then .Rows(b.Row).Clear
        Next b
    End With
End Sub

Sorry, muss weg. Arbeit wartet.

Gruß, Raoul

[ari-2001]

Hallo zusammen und vielen Dank.

Leider löscht er mir die Zeilen, in denen die Werte vorkommen,
er soll aber die Zeilen löschen, in denen die Werte NICHT vorkommen.

Wie fange ich das an?

Viele Grüße
Andreas

[MisterBurns]

Kann ich zwar nicht nachvollziehen, aber dann schreibe im Code halt statt
= 0 Then
eben
> 0 Then

Auf Fragen in privaten Nachrichten antworte ich grundsätzlich nicht.

[ari-2001]

Hallo Benni,

vielen lieben Dank, ich war einfach nur zu dösig  

Je nachdem auf welchen Blatt ich grade aktiv bin, geht dein Code natürlich einwandfrei.
Wenn ich allerdings auch so blöd bin und das Makro auf dem Datenblatt auszuführen, darf ich mich nicht
wundern, wenn es nicht funktioniert!

Hab vielen lieben Dank und ein schönes Wochenende!

Andreas