hücreler aradığım kelimeleri içeriyorsa nasıl silebilirim.

[oasikhan]

Arkadaşlar merhaba,
Forumdan çok faydalanıyorum ancak bir soruma cevap bulamadım.
ekteki örnekte mail adreslerim var. hücrelerde örneğin hotmail,msn,yahoo,usa kelimeleri geçiyorsa içeren hücrelerin tamamının silinmesini istiyorum. Değiştir ile yaptığımızda en fazla iki değer atayabiliyoruz. ama ben hotmail yada usa yada yahoo yada mynet vs. vs. gibi tam 30 değerden biri hücrede varsa o hücrenin silinmesini istiyorum teşekkür ederim. herkese iyi çalışmalar.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Sil()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To [A65536].End(3).Row
    If Cells(i, "A").Value Like "*hotmail*" Or _
       Cells(i, "A").Value Like "*msn*" Or _
       Cells(i, "A").Value Like "*yahoo*" Then
       Cells(i, "A").Delete Shift:=xlUp
    End If
Next i
Application.ScreenUpdating = True
End Sub

 

[oasikhan]

çok teşekkür ederim beni saatler sürecek bir işten kurtardınız. tekrar teşekkürler.

 

[ilkeremir]

Aradığımı buldum teşekkür ederim...
Bu arada silme işi çok güzel çalışıyor ama o hücreyi biçimlendirecek olsaydık nasıl bir değişiklik yapmamız gerekirdi acaba?
Teşekkürler...

 

[Necdet]

Merhaba,

Kodu inceleyiniz. Kırmızı ile belirtilen yerde Arka plan rengi kırmızı, fontununda koyu ve italik yazıldığını göreceksiniz.

Sub Sil()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To [A65536].End(3).Row
    If Cells(i, "A").Value Like "*hotmail*" Or _
       Cells(i, "A").Value Like "*msn*" Or _
       Cells(i, "A").Value Like "*yahoo*" Then
[COLOR=red][B]       With Cells(i, "A")
            .Interior.ColorIndex = 3
            .Font.Bold = True
            .Font.Italic = True
       End With
[/B][/COLOR]    End If
Next i
Application.ScreenUpdating = True
End Sub