Excel: 2 Spalten vergleichen, Doppelte löschen.

Question

Hi, ich habe ein Excel-Problem, das ich nicht gelöst bekomme:
Gegeben sind zwei Spalten mit Namen, es sollen aus Spalte 1 alle Einträge (Buchstaben, nicht Zahlen) gelöscht werden, die auch in Spalte 2 vorkommen. Problem dabei: die Einträge sind nicht immer exakt gleich, teilw. hängen an einem Wort noch Zusatzbezeichnungen, so dass der Tabellenfeldinhalt nicht exakt identisch ist, trotzdem aber gelöscht werden soll, also zB: lösche aus Spalte 1 alle Zeilen, in denen die ersten 8 (oder 10...) Buchstaben identisch sind mit einer Zeile aus Spalte 2. So was in der Art...

Wie müsste ich vorgehen?

Answer 1

Hallo,

kannst du mal ein Beispiel posten, wie die Daten aussehen, wenn so ein Eintrag aus Spalte 1 gelöscht werden soll.

Gruß

M.O.

Answer 2

Es sind Medikamentennamen, die Bezeichnung des selben Medikamentes ist in den zwei Spalten nicht immer identisch, obwohl es sich um das gleiche handelt.

Bsp:

Spalte 1: Amoxicillin, Clavulansäure
Spalte 2: Amoxicillin/Kalium-Clavulanat

oder

Spalte 1: Ampicillin, Sulbactam  
Spalte 2: Ampicillin/Sulbactam

So in der Art, wobei diese Namen nicht in der selben Zeile stehen. Spalte 1 ist dtl. länger, als Spalte 2.

Hilft das weiter?

Schöne Grüße
derpfleger

Answer 3

Hallo,

das Problem sind die "unscharfen" Begriffe wie in deinem 1. Beispiel. Im 2. Beispiel kann aus Spalte 2 die Suchbegriffe einfach trennen und vergleichen. Im 1. Beispiel geht das nicht. Trennt man "Amoxicillin/Kalium-Clavulanat", so erhält man "Amoxicillin" und "Kalium-Clavulanat". Den 1. Begriff findet man bei einem Vergleich noch, den 2. Begriff schon nicht mehr. Und wenn man z.B. nur die ersten 8 Buchstaben vergleicht, so findet man "Kalium-C" auch nicht.

Das erste Beispiel kann man mit VBA lösen, das zweite nicht. 

Gruß

M.O.

Answer 4

Korrigiert auf Mehrfachtreffer!

Sub Löschen()
Application.ScreenUpdating = False
Dim ZeileA As Long, ZeileB As Long
 For ZeileB = 2 To ActiveSheet.Range(Cells(Rows.Count, 2), Cells(Rows.Count, 2)).End(xlUp).Row
  For ZeileA = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row To 2 Step -1
  If InStr(1, Range("B" & ZeileB), "/") - 1 > 0 Then
  If InStr(1, Range("A" & ZeileA), Mid(Range("B" & ZeileB), 1, InStr(1, Range("B" & ZeileB), "/") - 1)) > 0 Then Range("A" & ZeileA).Delete Shift:=xlUp
  End If
  Next ZeileA
 Next ZeileB
Application.ScreenUpdating = True
End Sub