doppelte oder mehrfache Begriffe entfernen

[Strumpf-Maus]

Hallo,

ich suche die Möglichkeit innerhalb eines bestimmten Bereichs (z.B. Zeile 4 - 8) doppelte oder mehrfach vorkommende Begriffe zu finden und diese zu entfernen.
Im Screenshot ist ein Beispiel zu sehen wie das aussehen könnte, hier kommt das Wort "Stoff" mehrfahch vor und soll aus Zelle "C" und "F" entfernt werden, das zweite Wort, in diesem Fall "Tiger" und "Pferd" soll jedoch nicht gelöscht werden.

Hat jemand eine Idee

Danke

[BoskoBiati]

Hi,

suchen/ersetzen.

[Strumpf-Maus]

Funktioniert für meinen Zweck nicht, bitte Problem genau lesen!

[Käpt'n Blaubär]

Hallo,

Funktioniert für meinen Zweck nicht, bitte Problem genau lesen!

... und was soll daran nicht funktionieren?
Soll das ausgewürfelt werden, oder erklärst Du das mal genauer?

[WillWissen]

Hi,

lass die erste Zelle, in der der Begriff auftaucht, aus der Markierung heraus. Den Rest kannst du einwandfrei mit Edgars Vorschlag lösen.

[Strumpf-Maus]

Hallo Günther,

ich weiß nicht wo der erste Begriff vorkommt, manchmal kommt er pro Zeile nur einmal vor, manchmal häufiger und er steht nicht immer an der gleichen Position.
Ausserdem sind es mehrere Begriff die mehrfach vorhanden sind, das manuelle Suchen ist zu aufwendig deshalb habe ich auf eine andere Lösung gehofft.

[Strumpf-Maus]

Hallo,


... und was soll daran nicht funktionieren?
Soll das ausgewürfelt werden, oder erklärst Du das mal genauer?

Die Anforderung habe ich doch genau  definiert, da muss man nicht würfeln sondern genau lesen!
Wenn ich über Suchen/Ersetze die Begriffe entferne werden ALLE Begriffe entfern und nicht nur die Begriffe die doppelt oder mehrfach vorhanden sind.

[Kuwer]

Hallo Strumpf-Maus,

teste es mal mit folgendem Makro (kommt in ein allgemeines VBA-Modul):

Sub AlleMehrfachenLoeschen()
  Dim colW As New Collection
  Dim i As Long, j As Long, k As Long
  Dim rngB As Range
  Dim varB As Variant, varZ As Variant
  
  Set rngB = Range("A1:F1") 'Bereich entsprechend festlegen
  varB = rngB.Value
  On Error Resume Next
  For i = 1 To UBound(varB, 1)
    For j = 1 To UBound(varB, 2)
      varZ = Split(varB(i, j), " ")
      For k = 0 To UBound(varZ)
        colW.Add CStr(varZ(k)), CStr(varZ(k))
        If Err.Number > 0 Then
          varB(i, j) = Trim(Replace(varB(i, j), varZ(k), ""))
          Err.Clear
        End If
      Next k
    Next j
  Next i
  rngB.Value = varB
End Sub

Gruß Uwe

[Strumpf-Maus]

Hallo Kuwer,

ich habe de Code eingefügt aber es passiert nichts.
Muss ich noch irgendwas machen damit der Code aktiv wird?

[Kuwer]

Hallo Strumpf-Maus,

1. musst Du den Zellbereich entsprechend eintragen und
2. den Code ausführen/starten.

Gruß Uwe