Aynı hücre içinde tekrar eden verilerin kaldırılması

[bikurti]

Arkadaşlar Selamlar,

A sütununda şöyle veriler var;

Ahmet mehmet ali esenler istanbul esenler
cevdet kazım ayşe halkalı kayseri kayseri
selim kamuran bülent aksaray istanbul aksaray istanbul

bu aynı hücre içindeki çift olan değerlerin birini kaldırıp
şöyle bir sonuca ulaşmaya çalışıyorum.

Ahmet mehmet ali esenler istanbul
cevdet kazım ayşe halkalı kayseri
selim kamuran bülent aksaray istanbul

Bu konuda yapabileceğim birşey varmı ?
Yardımcı olabilirseniz sevinrim

Saygılarımla

 

[Asri]

..
Ahmet mehmet ali esenler istanbul esenler
cevdet kazım ayşe halkalı kayseri kayseri
selim kamuran bülent aksaray istanbul aksaray istanbul

bu aynı hücre içindeki çift olan değerlerin birini kaldırıp
şöyle bir sonuca ulaşmaya çalışıyorum...

Bunların her biri ayrı satırda mı?
Ahmet mehmet ali esenler istanbul esenler gibi.

Tek hücrede mi?
Ahmet mehmet ali esenler istanbul esenler
cevdet kazım ayşe halkalı kayseri kayseri
selim kamuran bülent aksaray istanbul aksaray istanbul

 

[Asri]

Kontrol ediniz.

Veriler A1 dahil A sütununda olmalı. B sütununa elenmiş bilgilyer aktarılır.

Sub menu()
   Call ele
End Sub

Sub ele()
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  For i = 1 To sonsatir
    veri = WorksheetFunction.Trim(tek_bosluk(Cells(i, 1).Value))
    liste = Split(veri, " ")
    islem = False
   For tekrar = 1 To 4
       veri = WorksheetFunction.Trim(tek_bosluk(veri))
       liste = Split(veri, " ")
       islem = False
    For j = UBound(liste) To LBound(liste) Step -1
     
      kelime1 = ""
      kelime2 = ""
      kelime3 = ""
      kelime3 = liste(j)
      
      If j - 1 >= LBound(liste) Then kelime2 = liste(j - 1)
      If j - 2 >= LBound(liste) Then kelime1 = liste(j - 2)
      If kelime3 = kelime2 And (kelime3 <> "" And kelime2 <> "") Then
         liste(j) = ""
         kelime3 = ""
         islem = True
      End If
      
      If kelime2 = kelime1 And (kelime2 <> "" And kelime1 <> "") Then
         liste(j - 1) = ""
         kelime2 = ""
         islem = True
      End If
      
      If kelime1 = kelime3 And (kelime1 <> "" And kelime3 <> "") Then
         liste(j - 2) = ""
         kelime1 = ""
         islem = True
      End If
      
      If islem Then
         veri = ""
         For j1 = 0 To UBound(liste)
           veri = veri & " " & liste(j1)
         Next j1
         Cells(i, 2).Value = WorksheetFunction.Trim(tek_bosluk(veri))
         islem = False
      End If
    Next j
  Next tekrar
  Next i
  
End Sub

Public Function tek_bosluk(cumle)
  gecici = ""
  eski = "99"
  If InStr(1, cumle, " ") > 0 Then
    For i = 1 To Len(cumle)
      h = Mid(cumle, i, 1)
      If eski <> " " Then
        gecici = gecici + h
      ElseIf eski = " " And h <> " " Then
        gecici = gecici + h
      End If
      eski = h
    Next i
    tek_bosluk = gecici
  Else
    tek_bosluk = cumle
  End If
End Function