Birbirine benzeyen cümleleri yakalama

[bsen]

Merhaba,
Zor olduğunu düşündüğüm bir konuda yardıma ihtiyacım var. Ekteki örnekte olduğu gibi 500'e yakın cümleden oluşan bir dosyam var. Her cümlenin başında numarası var. Benim ihtiyacım olan şey, bağımsız bir hücrede yazdığım sayıyı baz alarak (J2) hücresi, orada yazan sayı kadar kelimeyi, her cümle için tek tek kontrol ederek, J2 hücresinde yazan sayı kadar aynı kelimenin olduğu cümlenin numarası kaç ise onun D sütununa yazılması. Biraz karışık gelebilir örnek dosyadan buraya yazıya dökeyim.

Ek dosyada göreceğiniz üzere herhangi 2 kelimesi benzeyen cümleleri bulmasını istedim ve o da bana 3 ve 4 no. lu cümlelerde 2'şer ortak kelime olduğu için D hücresine yazdı. Bunu manuel yaptım ve otomatiğine ihtiyacım var anlayacağınız. Çözebilen varsa çok makbule geçer.

Selamlar,

 

[Necdet]

Merhaba,

Cümleden söz ediyorsunuz ama sözcüklerden hareket ediyorunuz, ben öyle anladım.
Sizin "Cümle No" dediğinizden ben "Sıra No" anlıyorum. Dolayısıyla 3 v 4. sıralardaki tümcelerden tek ekleşen "Dün" sözcüğü.
Siz 3. sıraya 4, 4. sıraya 3 rakamını yazdırıyorsunuz.

Doğru mu anladım?

Ben yapabilirim anlamında sormuyorum, konuya açıklık getirmek için sordum.

Sonra kabak benim başıma patlamasın

 

[bsen]

Teşekkür ederim doğru anlatmışsınız. Biraz telaşe yazdım anlam karışıklığı olmuş. Sizin yazdığınız gibidir.

 

[Muzaffer Ali]

Bence @bsen sorusunu doğru soramıyor.
3. ve 4. cümlelerde bir değil iki eşleşme var "Dün" ve "Çok" buna göre yukarıda söyledikleri doğru.

Peki şöyle bir şey olsa ne olacak?

5 nolu Cümlede : "Dün ben de diziyi seyrettim." yazıyorsa bu durumda 3 numaralı cümlenin D sütununa ne yazacağız 3 mü 4 mü yoksa her ikisini de (3, 4) mi

 

[Muzaffer Ali]

Aşağıdaki kodu sayfanızın kod kısmına kopyalayıp çalıştırın.

Sub test()
    Dim Bak As Integer
    Dim Bak2 As Integer
    Dim Kelimeler
    Dim BakKelime As Integer
    Dim Bul As Range
    Dim BulunanSay As Integer
    Dim Virgul As String
    For Bak = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        Kelimeler = Split(Cells(Bak, "C").Text, " ")
        For Bak2 = Bak + 1 To Cells(Rows.Count, "C").End(xlUp).Row
            BulunanSay = 0
            For BakKelime = 0 To UBound(Kelimeler) - 1
                Set Bul = Cells(Bak2, "C").Find(Kelimeler(BakKelime))
                If Not Bul Is Nothing Then
                    BulunanSay = 1 + BulunanSay
                    If BulunanSay = Range("J2") Then
                        If Cells(Bak, "D") = "" Then
                            Virgul = ""
                        Else
                            Virgul = ","
                        End If
                        
                        Cells(Bak, "D") = Cells(Bak, "D") & Virgul & Cells(Bak2, "B")
                        
                        If Cells(Bak2, "D") = "" Then
                            Virgul = ""
                        Else
                            Virgul = ","
                        End If
                        
                        Cells(Bak2, "D") = Cells(Bak2, "D") & Virgul & Cells(Bak, "B")
                    End If
                End If
            Next
        Next
    Next
End Sub