Hücre içinde bir den fazla tekrarlanan kelimeleri çıkartmak

yasin85 · 29 Haziran 2020

Herkese Merhaba Kolay Gelsin,

Bir hücre içerisinde aynı kelimeden birden fazla varsa tekrarlananları alt örnekteki gibi tek hale nasıl getire biliriz.
Not: Sadece Metin içerikli işlemler için gerekli, Sayısal değerler olduğu gibi kalmasını istiyoruz.
Bu konuda yardımcı ola bilirmisiniz.

kulomer46 · 29 Haziran 2020

Merhaba

İsterseniz makrolu çözüm yazabilirim.
Sadece fonksiyonlu çözüm istiyorsanız şu an aklıma bir şey gelmiyor.

Selamlar...

recepkull · 29 Haziran 2020

Murat OSMA' Alıntı:
Merhaba,
Gönüllü olarak, işinden, özel zamanından vakit ayırıp size yardımcı olacak kişileri uğraştırmamak adına, örnek dosya eklemeyi alışkanlık hâline getirelim. Sonrasında herkes elinden geldiğince yardımcı olacaklardır.

Saygılar

veyselemre · 29 Haziran 2020

Örnek dosya yok, hücre içerisinde alt+enter kullanıldıysa hatalı sonuç verecektir.

Kod:

Sub TEST()
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        bl = Split(Cells(i, 1))
        For ii = LBound(bl) To UBound(bl) - 1
            al = bl(ii)
            If Not IsNumeric(al) Then
                For iii = ii + 1 To UBound(bl)
                    If al = bl(iii) Then bl(iii) = ""
                Next iii
            End If
        Next ii
        Cells(i, 2) = WorksheetFunction.Trim(Join(bl))
    Next i
End Sub

Korhan Ayhan · 29 Haziran 2020

Altenatif;

C++:

Option Explicit

Sub Metin_Icindeki_Tekrar_Edenleri_Kaldir()
    Dim Dizi As Object, Veri As Variant, Son As Long, X As Long, Say As Long
    Dim Metin As Variant, Y As Integer, Ek As Integer, Sonuc As String, Zaman As Double
    
    Zaman = Timer
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
    
    Veri = Range("A1:A" & Son).Value
    
    ReDim Liste(1 To UBound(Veri), 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            Metin = Split(Veri(X, 1), " ")
            For Y = LBound(Metin) To UBound(Metin)
                If Not IsNumeric(Metin(Y)) Then
                    If Not Dizi.Exists(Metin(Y)) Then Dizi.Add Metin(Y), Nothing
                Else
                    Ek = Ek + 1
                    Dizi.Add Metin(Y) & "|" & Ek, Nothing
                End If
            Next
            
            Sonuc = Join(Dizi.Keys, " ")
            
            Dizi.RemoveAll
            
            For Y = Ek To 1 Step -1
                Sonuc = Replace(Sonuc, "|" & Y, "")
            Next
        
            Ek = 0
            Say = Say + 1
            Liste(Say, 1) = Sonuc
            
            Sonuc = ""
        End If
    Next

    If Say > 0 Then Range("B1").Resize(Say, 1) = Liste
    
    Set Dizi = Nothing
    
    MsgBox "Tekrar eden veriler temizlenmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

yasin85 · 30 Haziran 2020

veyselemre' Alıntı:

Örnek dosya yok, hücre içerisinde alt+enter kullanıldıysa hatalı sonuç verecektir.

Kod:

Sub TEST()
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        bl = Split(Cells(i, 1))
        For ii = LBound(bl) To UBound(bl) - 1
            al = bl(ii)
            If Not IsNumeric(al) Then
                For iii = ii + 1 To UBound(bl)
                    If al = bl(iii) Then bl(iii) = ""
                Next iii
            End If
        Next ii
        Cells(i, 2) = WorksheetFunction.Trim(Join(bl))
    Next i
End Sub

sn. @veyselemre emeğiniz için teşekkür ederim çok işime yarayacak bir çalışma oldu.
dosyayıda ekliyorum ihtiyacı olan arkadaşlar kullana bilir..
iyi akşamlar

yasin85 · 30 Haziran 2020

Korhan Ayhan' Alıntı:

Altenatif;

C++:

Option Explicit

Sub Metin_Icindeki_Tekrar_Edenleri_Kaldir()
    Dim Dizi As Object, Veri As Variant, Son As Long, X As Long, Say As Long
    Dim Metin As Variant, Y As Integer, Ek As Integer, Sonuc As String, Zaman As Double
   
    Zaman = Timer
   
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
   
    Veri = Range("A1:A" & Son).Value
   
    ReDim Liste(1 To UBound(Veri), 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            Metin = Split(Veri(X, 1), " ")
            For Y = LBound(Metin) To UBound(Metin)
                If Not IsNumeric(Metin(Y)) Then
                    If Not Dizi.Exists(Metin(Y)) Then Dizi.Add Metin(Y), Nothing
                Else
                    Ek = Ek + 1
                    Dizi.Add Metin(Y) & "|" & Ek, Nothing
                End If
            Next
           
            Sonuc = Join(Dizi.Keys, " ")
           
            Dizi.RemoveAll
           
            For Y = Ek To 1 Step -1
                Sonuc = Replace(Sonuc, "|" & Y, "")
            Next
       
            Ek = 0
            Say = Say + 1
            Liste(Say, 1) = Sonuc
           
            Sonuc = ""
        End If
    Next

    If Say > 0 Then Range("B1").Resize(Say, 1) = Liste
   
    Set Dizi = Nothing
   
    MsgBox "Tekrar eden veriler temizlenmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

sn. @Korhan Ayhan zaman ayırıp destek olduğunuz için sizlere çok teşekkür ederim sizin dosyanızıda ekledim denemek isteyen olursa diye bu işlem haftada toplama vurduğumuzda en az 5 - 6 saatimizi alıyordu böyle bir iş yükü üstümüzden kalktı şuanda.

iyi akşamlar, teşekkürler.

yasin85 · 30 Haziran 2020

kulomer46' Alıntı:
Merhaba

İsterseniz makrolu çözüm yazabilirim.
Sadece fonksiyonlu çözüm istiyorsanız şu an aklıma bir şey gelmiyor.

Selamlar...

sn. @kulomer46 ilginiz için teşekkür ederim.
Fonksiyonla ile ola bilecek bir çalışma olduğunu düşündüğüm için fonksiyon alanına ekledim, makro ile değerli vakitlerini harcamasınlar diye sağolsunlar desteklerini esirgemediler..

kulomer46 · 30 Haziran 2020

yasin85' Alıntı:
sn. @kulomer46 ilginiz için teşekkür ederim.
Fonksiyonla ile ola bilecek bir çalışma olduğunu düşündüğüm için fonksiyon alanına ekledim, makro ile değerli vakitlerini harcamasınlar diye sağolsunlar desteklerini esirgemediler..

Selamlar...

yasin85 · 3 Temmuz 2020

sn @veyselemre & sn @Korhan Ayhan

Destek olduğunuz bu kod çalışmasında bugün tekrardan ihtiyacımız oldu kullandık 30000 kalemlik bir liste idi o listede çalışmadı fakat bir kaç kalem olduğunda çalışıyor. çalışma alanını mümkünse 30000 olarak revize ede bilirmisiniz.

Kolay gelsin

Korhan Ayhan · 3 Temmuz 2020

Benim önerdiğim kodda bir sınırlama yoktur. Hata vermemesi gerekir.

Kod hangi satırda hata veriyor?

yasin85 · 4 Temmuz 2020

Sn. @Korhan Ayhan bey,

Hata vermiyor, sadece tekrar edenleri kaldırmıyor.
Listede kaldırılmayanlardan bir kısmı aşağıdaki gibidir.

OGUZ KAAN ADALI ADALI
MEHMET ADLIM ADLIM
MUTALIP ADMIR ADMIR
IRFAN AKCIL AKCIL
KAMIL AKHAN AKHAN
ERHAN AKIN AKIN
MURAT AKMAN AKMAN
VEDAT AKSOY AKSOY
AYHAN AKSU AKSU
SERDAR AKTAS AKTAS
YASIN AKTAS AKTAS
NECMETTIN AKYILDIRIM AKYILDIRIM
AKIF AL AL AKIF

Korhan Ayhan · 4 Temmuz 2020

Örnek olarak verdiğiniz verileri boş bir dosyada 1 milyon satıra uyguladım. Hem @veyselemre beyin hem de benim önerdiğim kodu test ettim. Sıkıntı çıkarmadan çalıştı.

yasin85 · 4 Temmuz 2020

@Korhan Ayhan Bey, Müsait olduğunuzda ekte ki örneğe bakma bilirmisiniz.
Tekrarlanan veriler bu örnekte vardır.

Korhan Ayhan · 4 Temmuz 2020

Tekrarların silinmediği hücrelerde fazladan Chr(160) kodlu boşluk görünüyor. Hücre içlerine F2 ile girerseniz görebilirsiniz.

Aşağıdaki kodu deneyiniz.

C++:

Option Explicit

Sub Metin_Icindeki_Tekrar_Edenleri_Kaldir()
    Dim Dizi As Object, Veri As Variant, Son As Long, X As Long, Say As Long
    Dim Metin As Variant, Y As Integer, Ek As Integer, Sonuc As String, Zaman As Double
    
    Zaman = Timer
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
    
    Veri = Range("A1:A" & Son).Value
    
    ReDim Liste(1 To UBound(Veri), 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            Metin = Split(WorksheetFunction.Trim(Replace(Veri(X, 1), Chr(160), "")), " ")
            For Y = LBound(Metin) To UBound(Metin)
                If Not IsNumeric(Metin(Y)) Then
                    If Not Dizi.Exists(Metin(Y)) Then Dizi.Add Metin(Y), Nothing
                Else
                    Ek = Ek + 1
                    Dizi.Add Metin(Y) & "|" & Ek, Nothing
                End If
            Next
            
            Sonuc = Join(Dizi.Keys, " ")
            
            Dizi.RemoveAll
            
            For Y = Ek To 1 Step -1
                Sonuc = Replace(Sonuc, "|" & Y, "")
            Next
        
            Ek = 0
            Say = Say + 1
            Liste(Say, 1) = Sonuc
            
            Sonuc = ""
        End If
    Next

    If Say > 0 Then Range("B1").Resize(Say, 1) = Liste
    
    Set Dizi = Nothing
    
    MsgBox "Tekrar eden veriler temizlenmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

yasin85 · 4 Temmuz 2020

@Korhan Ayhan Bey,

çok teşekkür ederim şuan mükemmel bir şekilde çalışıyor.

İyi günler.

aacanakova · 17 Şubat 2021

Korhan hocam , arkadaşta çalışmış ama ben çalıştıramadım.
Ekteki dosyaya bakarmısınız .
Bir isim ve bir telefon numarası (aynı satırda farklı bir telefon varsa iki farklı olan da) kalmasını istiyorum .

Haluk · 17 Şubat 2021

Kişisel bilgileri içeren dosya paylaşmasanız iyi olacaktı ....

.

aacanakova · 17 Şubat 2021

Değiştirdim numaraları

Korhan Ayhan · 17 Şubat 2021

Kodun sizin verilerinizde çalışması için düzenlenmesi gerekir.

Hücre içinde bir den fazla tekrarlanan kelimeleri çıkartmak

yasin85

kulomer46

recepkull

veyselemre

Özel Üye

Korhan Ayhan

Administrator

yasin85

Ekli dosyalar

yasin85

Ekli dosyalar

yasin85

kulomer46

yasin85

Korhan Ayhan

Administrator

yasin85

Korhan Ayhan

Administrator

yasin85

Ekli dosyalar

Korhan Ayhan

Administrator

yasin85

aacanakova

Ekli dosyalar

Haluk

Özel Üye

aacanakova

Korhan Ayhan

Administrator