Bir sütundaki belli kelimeleri tarayıp, o kelimenin geçtiği kutuyu başka bir sütuna taşıma.

[MouSTaPHa83]

Merhaba arkadaşlar.

Fonksiyonlarla yapmayı denedim ama beceremedim. Makrolardaki kodları yazmayı da bilmediğimden buradan sizlere sormak zorunda kaldım.

Bir yazıdaki cümleleri A sütununa yapıştıracağım.

Yazılacak kod bu cümlelerden içerisinde aynı iki kelime varsa o cümleyi silecek. Mesela

Herkes elma sever
Herkes armut sever

Bu iki cümle farklı satırlarda varsa "Herkes armut sever" satırını silecek.

Fakat aynı zamanda

Kitabını aldın mı
Kalemini aldın mı

cümlelerini de tespit ederse "Kalemini aldın mı" satırını da silecek.

Böyle bir makro yazılabilir mi?

Elimde aslında belirli kelimelerin geçtiği cümleleri silen bir kod var. Fakat bana asıl o cümleler gerekiyor. (Selam ve Naber kelimelerinin bulunduğu satırları B sütununa yazmak yerine bu iki kelimenin geçmediği satırları silen bir kod olsa o da işime yarayacaktır.) Yani bendeko kodun tam tersi de işime yarar.

 

[MouSTaPHa83]

Elimde aslında belirli kelimelerin geçtiği cümleleri silen bir kod var. Fakat bana asıl o cümleler gerekiyor. (Selam ve Naber kelimelerinin bulunduğu satırları B sütununa yazmak yerine bu iki kelimenin geçmediği satırları silen bir kod olsa o da işime yarayacaktır.) Yani bendeko kodun tam tersi de işime yarar.

Bu son paragrafı gözardı ediniz. Başka bir soru soracaktım ama elimdeki kodu ayarlayarak uğraşıp kendim hallettim.

 

[ÖmerFaruk]

1. Örneğin A1 de Ahmet elma yedi yazarken, diğer hücrelerde benzer kelime sayısı 0 ya da 1 ise herhangi bir silme işlemi yapacak mı?
2. Karşılaştırılan hücrelerde 2 den fazla benzer kelime varsa silme işlemi olacak mı?
3. Büyük - küçük harf dikkate alınacak mı?
4. Rakamla yazılan 5 , beş ifadesinden farklı mı aynı mı kabul edilecek?
5. Soru ekleri mı-mi-mu-mü kelime olarak mı algılanacak?
6. Ayrı yazılan "de" "da" ifadeleri kelime olarak mı algılanacak?
7. İmla işaretleri "." "," "-" vb. kelime olarak mı algılanacak?
8. Referans alınan hücredeki benzer kelime sayısı birden fazla satırda varsa sadece ilk bakılan satır mı yoksa hepsi mi silinecek?

 

[MouSTaPHa83]

Öncelikle istediğim şeyi tam olarak açıklamadığım için özür dilerim. Kodların ne kadar spesifik olabildikleri aklımdan çıkmış.

1 ve 2: Daha net olarak şöyle açıklayabilirim. Her satırda 3 ya da daha fazla isim olacak. bu üç isimden herhangi 2 ya da daha fazla isim başka kendinden önceki satırlardan herhangi birinde varsa o satır silinecek.
3: Büyük küçük harf önemli değil.
4, 5, 6 ve 7: Sadece isimler olduğu için rakam olmayacak. Ayrıca ayar yapılmasına gerek yok yani.
8: Sadece ilk bakılan satır kalacak. Diğer tüm satırlar silinecek.

İlgilendiğiniz için çok teşekkür ederim.

 

[MouSTaPHa83]

Bir de örnek vermem gerekirse:


1: Ahmet Hasan Veli
2: Ahmet Hüseyin Mehmet Leyla
3: Ali Veli Hatice
4: Ahmet Lütfiye Ege Veli Can (Ahmet ve Veli ilk satırda olduğu için silinecek)
5: Ali Hasan Veli (Ali ve Veli üçüncü satırda olduğu için silinecek)
6: Lütfü Muhammed İbrahim Canan
7: Hasan Veli Emine (Hasan ve Veli ilk satırda olduğu için silinecek)

 

[ÖmerFaruk]

Sayfanızın yedeğini alıp deneyin lütfen.

Sub TekrarlarıSil()
Dim Dizi1 As Variant
Dim Dizi2 As Variant
Dim i As Integer
For i = 7 To 1 Step -1
    Dizi1 = Split(Range("A" & i), " ")
    If UBound(Dizi1) < 2 Then GoTo 10
    For k = 1 To i - 1
        Dizi2 = Split(Range("A" & k), " ")
        say = 0
        For x1 = LBound(Dizi1) To UBound(Dizi1)
            For x2 = LBound(Dizi2) To UBound(Dizi2)
                If Dizi1(x1) = Dizi2(x2) Then say = say + 1
                If say = 2 Then
                    Rows(k).Delete
                    i = i - 1
                    k = k - 1
                    If k = i - 1 Then GoTo 10
                    GoTo 20
                End If
            Next x2
        Next x1
20
    Next k
10
Next i
End Sub

 

[MouSTaPHa83]

Çok teşekkür ederim. Olmuş gibi duruyor. Sadece satır sayısı fazla olduğu için çalışmamıştı.


For i = 7 To 1 Step -1

satırındaki 7yi 700 olarak değiştirdim şimdi çalışıyor. (Ne yaptığım konusunda hiçbir fikrim yok)

Tek bir sorun var o da 100 satırdan önce 30unu sildi. Tekrar çalıştırdım 68e düştü. (Yani anladığım kadarıyla birkaç satırı ilk denemede silemedi.) Ama sorun değil. Bu şekilde de gayet işime yarıyor.

Tekrar tekrar teşekkür ederim.

 

[veyselemre]

Sub test()
    Dim i&, ii&, iii&, say As Byte, bl
    For i = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        bl = Split(Cells(i, 1).Value, " ")
        If UBound(bl) < 1 Then GoTo skip
        For ii = i - 1 To 1 Step -1
            say = 0
            For iii = 0 To UBound(bl)
                If InStr(Cells(ii, 1).Value, bl(iii)) > 0 Then
                    say = say + 1
                    If say > 1 Then
                        Rows(i).Delete
                        GoTo skip
                    End If
                End If
            Next iii
        Next ii
skip:
    Next i
End Sub

Sub test()
    Dim i&, ii&
    With CreateObject("Vbscript.Regexp")
        .Global = True
        i = 1
        Do While Cells(i, 1).Value <> ""
            .Pattern = Replace(Cells(i, 1).Value, " ", "|")
            For ii = i + 1 To Cells(Rows.Count, 1).End(3).Row
                If .Execute(Cells(ii, 1).Value).Count > 1 Then Rows(ii).Delete
            Next ii
            i = i + 1
        Loop
    End With
End Sub