satır silme makrosu

[yakup123]

merhabalar

sayın üstadlarım bi mail listem mevcut

hücre içeriginde hotmail geçen mail adresinin satırını silmek istiyorum
nasıl bır makrodur acaba
yardımınız için şimdiden çok teşekkur ederım

 

[zagortr]

Sub a()
Dim a As Integer
Sheets("sayfa1").Select
For a = 1 To 10000
If Trim(Cells(a, 1).Value) = "" Then Exit For
If InStr(1, Cells(a, 1).Value, "hotmail", vbTextCompare) > 0 Then
Range("A" & a).Select
Selection.EntireRow.Delete
End If
Next
End Sub

 

[yakup123]

merhaba

sayın zagor çok teşekkur ederım
saygılarımla

 

[Korhan Ayhan]

Selamlar,

Verilen cevaptaki döngüde bir problem olmalı. Bu şekilde kuracağınız döngüde tüm verileri doğru şekilde silemezsiniz. Döngü tersten başlamalıdır. Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub MAİL_SİL()
    Dim X As Long
 
    Application.ScreenUpdating = False
 
    For X = Range("A65536").End(3).Row To 1 Step -1
        If InStr(1, Cells(X, 1), "hotmail", vbTextCompare) > 0 Then Rows(X).Delete
    Next
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[karakayalı]

sayın korhan ayhan, b sutununda yer alan hotmail kelimelerini silmemiz için formülü nasıl değiştirmemiz gerekir...("A65536") ("b65536") şeklinde değiştirdim ancak olmadı...

 

[Korhan Ayhan]

Selamlar,

Bahsettiğiniz değişkliği yapın. Ayrıca kod içinde geçen aşağıdaki satırdaki kırmızı renkli bölümüde 2 olarak düzeltin.

Cells(X, [COLOR=red]1[/COLOR])

 

[karakayalı]

sayın korhan ayhan, teşekkürler...

 

[Ahmet ÖZGÜR]

Soruma cevap buldum

Teşekkürler Koray Bey,

Bende konudan kendim için aradığım soruya cevap buldum.

İyi çalışmalar.

Selamlar,

Verilen cevaptaki döngüde bir problem olmalı. Bu şekilde kuracağınız döngüde tüm verileri doğru şekilde silemezsiniz. Döngü tersten başlamalıdır. Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub MAİL_SİL()
    Dim X As Long
 
    Application.ScreenUpdating = False
 
    For X = Range("A65536").End(3).Row To 1 Step -1
        If InStr(1, Cells(X, 1), "hotmail", vbTextCompare) > 0 Then Rows(X).Delete
    Next
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub