Zeilen automatisch markieren/löschen, wenn bestimmte Bedingung erfüllt ist

[pantens]

Hallo!

Ich habe in einer Tabelle in Spalte B folgende Daten (Tabelle hat viele Spalten):

CA167
CA1670R
CA1671
CA1671R
CA1672
CA1672R
CA1673
CA1673R
CA1674R
CA167R
CA168

Wenn eine Nummer mit einem Suffix versehen ist, aber bereits die Grundnummer existiert, dann soll die komplette Zeile der Suffix-Nummer gelöscht werden.
Somit würde sich Folgendes ergeben:

CA167
CA1670R
CA1671
CA1672
CA1673
CA1674R
CA168

Da die ein großer manueller Aufwand ist, hier die Frage, ob jemand eine Idee hat, wie man dies vereinfachen oder automatisieren kann.

Schon jetzt vielen Dank für jede Anregung.

Viele Grüße
pantens

[chris-ka]

Hi,

anbei eine Versuch

Code:

Option Explicit

Sub stantiv()
Dim objF As Object, i As Long, rng_Big As Range, str_firstMatch As String
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    If Right(Cells(i, 2).Value, 1) <> "R" Then
        Set objF = Columns(2).Find(Cells(i, 2).Value & "R", lookat:=xlWhole)
        If Not objF Is Nothing Then
            str_firstMatch = objF.Address
            Do
                If rng_Big Is Nothing Then
                    Set rng_Big = objF
                Else
                    Set rng_Big = Union(rng_Big, objF)
                End If
            Loop While Not objF Is Nothing And str_firstMatch <> objF.Address
           Set objF = Nothing
        End If
    End If
Next
If Not rng_Big Is Nothing Then rng_Big.Delete
End Sub

[pantens]

Hallo Chris-Ka!

Zunächst einmal vielen Dank für die schnelle Antwort. Leider hilft mir das nicht, da ich nicht weiß, was ich damit machen muss.
Soll ich ein Spalte C einfügen und diesen Text in jede Zelle eingegeben?

Viele Grüße,
pantens

PS: Das Katzenbild ist ja Klasse!

[chris-ka]

Hi,

^^

Soll ich ein Spalte C einfügen und diesen Text in jede Zelle eingegeben?

nein :)

Öffne deine Mappe -> drücke Alt+F11
gehe auf Menü Einfügen -> Modul
kopiere meinen Code dort hinein
Schließe das Fenster
wechsle auf das Blatt wo in Spalte B deine Daten stehen -> drücke Alt+F8 -> wähle "stantiv" aus -> klicke auf Ausführen.
fertig :)

[atilla]

Hallo zusammen,

ich habe vor kurzem gelernt, dass man so etwas schneller mit Formeln lösen kann, deshalb hier eine Variante mit Formeln in der Hilfsspalte C:

Code:

Option Explicit

Sub doppelte_löschen()
   Dim lngZ As Long
   lngZ = Cells(Rows.Count, 2).End(xlUp).Row
   Range("C2:C" & lngZ).FormulaLocal = "=WENN(RECHTS(B2;1)=" & """" & "R" & """" & ";WENN(ZÄHLENWENN($B$2:B2;LINKS(B2;LÄNGE(B2)-1))>0;1;" & """""" & ");" & """""" & ")"
   On Error Resume Next 'falls keine doppelten kommt ds sonst zum Fehler
   Range("C2:C" & lngZ).SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
   Range("C2:C" & lngZ).Clear
End Sub

Der Code gehört in das Code Modul der Tabelle mit den Werten.
Rechtsklick auf den Tabellenreiter und im sich öffnenden Kontextmenü "Code auswählen" anklicken.
Im sich öffnenden Fenster den Code einkopieren und so ausführen wie Chris es beschrieben hat.

Wie gesagt, der Code schreibt in Spalte C Formeln rein. Sollte die belegt sein, kannst Du auch jede andere Spalte nutzen.
Dazu im Code überall in diesem Ausdruck:
Range("C2:C" & lngZ)

den Buchstaben C (rot markiert) mit dem von Dir gewünschten Spaltenbuchstaben ersetzen.

Außerdem gehe ich davon aus, dass Deine Daten Ab Zeile 2 vorliegen.

[pantens]

Ihr seid SPITZE!!! Hut ab.

Vielen, vielen Dank. Bei 30000 Zeilen ist das eine richtige Zeitersparnis.

Viele Grüße & ein schönes WE
pantens

[atilla]

Hallo,

mich würde schon interessieren, welche Version Du nutzt, denn sie führen nicht immer zum selben Ergebnis.