Sayı içermeyen satırları temizlemek

[xternet]

Merhaba arkadaşlar.
Lazım olan kodu oluşturmak için bazı konu başlıklarını inceledim ama istediğim cevaba ulaşamadım.
Yapmak istediğim şey; makro kodu ile A sütunundaki (Mesela A1 ile A2000 arasındaki) hücrelere bakıp, sayıdan farklı ve boş olan hücrelerin bulunduğu satırları temizletmek. (Temizlemekten kastım verileri silmek.)
Bir örnek dosya ekledim. Zaman ayıracak arkadaşlara şimdiden teşekkür ederim.
İyi çalışmalar.

 

[askm]

Aşağıdaki kodları deneyin.

Sub ASKM_SayiOlmayanSil()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
Application.ScreenUpdating = False
For i = son To 12 Step -1
    If Cells(i, 1) = Empty Or IsNumeric(Cells(i, 1)) = False Then
        Rows(i).Delete
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[çıtır]

Deneyiniz.

Sub sil()
Application.ScreenUpdating = False
Dim s1 As Worksheet
Dim i As Integer
Set s1 = Sheets("Sayfa1")
son = s1.Cells(65336, "A").End(3).Row
For i = son To 1 Step -1
If IsNumeric(s1.Range("A" & i)) = False Or s1.Range("A" & i) = "" Then
s1.Rows(i).Delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
End Sub

 

[Seyit Tiken]

Bu şekilde bir deneyiniz.

[a1:a2000].SpecialCells(2, 2).Value = ""

 

[xternet]

Sayın Tiken;
Yazdığınız kod tek satır ve çok pratik göründüğü için ilk bu kodu denedim.
Kod sadece A sütunundaki sayıdan farklı hücreleri temizliyor. Aynı satırın diğer sütunlarında işlem yapmıyor.
Bende sizin kod ile daha önce kullandığım şu kodu birleştireyim dedim:

Sub deneme2()

'a sutununda boş hücrelerin satırı temizleniyor

[a1:a2000].SpecialCells(2, 2).Value = ""

For k = 1 To 2000
If Range("A" & k) = "" Then
Rows(k).Select
Selection.ClearContents
End If

Next k


End Sub

Kod ilk satırda hata vererek durdu.
Bu entegre nasıl yapılabilir.

Bu şekilde bir deneyiniz.

[a1:a2000].SpecialCells(2, 2).Value = ""

 

[xternet]

Aşağıdaki kodları deneyin.

Sub ASKM_SayiOlmayanSil()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
Application.ScreenUpdating = False
For i = son To 12 Step -1
    If Cells(i, 1) = Empty Or IsNumeric(Cells(i, 1)) = False Then
        Rows(i).Delete
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

Sayın askm;
Kod tek başına çalışıyor. Yalnız benim istediğimden fazla olarak sayı içermeyen satırları tümden siliyor.
Bu şekliyke uzun bir kod içerisinde kullanmak istediğimde ise işlem tamamlanmıyor.
2-3 dakika beklememe rağmen hata da vermiyor. Esc ile durdurduğumda "End if" de takıldığını görüyorum

 

[Seyit Tiken]

Kodu günceledim, bu şekilde deneyiniz.

On Error Resume Next
[a1:k2000].SpecialCells(2, 2).Rows = ""

 

[xternet]

Kodu günceledim, bu şekilde deneyiniz.

On Error Resume Next
[a1:k2000].SpecialCells(2, 2).Rows = ""

Sayın Tiken;
Çok teşekkür ederim. Kod sorunsuz çalıştı.
Sadece [a1:k2000] yerine [a1:a2000] düzeltmesi yaptım.

 

[xternet]

Sayın Çıtır ve askm, alakanızdan dolayı sizlere de çok teşekkür ederim.