Tek Rakamlı Satırları Silme

[focus20]

İstediğim şey 1,3,5,7..... diye devam ederek veri bitene kadar o satırları silmesi yardımcı olan arkadaşlara şimdiden teşekkürler.

 

[Haluk]

Merhaba;

Sayfadaki en son verinin A sütununda olduğunu kabul edersek, aşağıdaki kod işinize yarayabilir.

Sub Test()
    noA = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To noA Step 2
        Range("A" & i) = "x"
    Next
    For i = noA To 1 Step -1
        If Range("A" & i) = "x" Then Rows(i).Delete Shift:=xlUp
    Next
End Sub

.

 

[Murat OSMA]

Alternatif;

[SIZE="2"]Sub Emre()
    son& = Range("A" & Rows.Count).End(3).Row
    For i& = son To 1 Step -1
        If i Mod 2 Then
            Rows(i).Delete Shift:=xlUp
        End If
    Next i
    i = Empty: son = Empty
End Sub[/SIZE]

 

[Ömer BARAN]

Merhaba.

Alternatif olsun.

-- Alt taraftan uygulamayı istediğiniz sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağ taraftaki BOŞ alana aşağıdaki kod'u yapıştırın,
-- KOD'u çalıştırın.
.

[B]Sub TEK_SIL()[/B]
son = [A1].SpecialCells(xlCellTypeLastCell).Row
If WorksheetFunction.IsOdd(son) = False Then son = son - 1
    For sat = son To 1 Step -2
        Rows(sat).Delete Shift:=xlUp
    Next
[B]End Sub[/B]

 

[Murat OSMA]

Ömer Bey'in kullandığı TEKMİ fonksiyonu ile alternatif..

[SIZE="2"][SIZE="2"]Sub Emre()
    For i& = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
        If WorksheetFunction.IsOdd(i) = True Then Rows(i).Delete Shift:=xlUp
    Next i
    i = Empty
End Sub[/SIZE][/SIZE]

 

[Haluk]

Başka bir alternatif;

Sub Test2()
    noA = Range("A" & Rows.Count).End(xlUp).Row
    For i = 0 To noA
        Rows(i + 1).Delete
    Next
End Sub

.

 

[Ömer BARAN]

Başka bir alternatif;
.........

Merhaba Sayın Haluk.

Öteden beri cevaplarınızdan yararlanıyoruz, teşekkürler.

Verdiğiniz kod'daki noA değişkenini aşağıdaki şekilde tanımlamak daha doğru olmaz mı?
Böylece silinen satırlar da işleme tabi tutulmamış olur bence.

İyi günler dilerim.
.

    [B]noA[/B] = [COLOR="Red"]Int([/COLOR]Range("A" & Rows.Count).End(xlUp).Row[COLOR="red"] / 2) + 1[/COLOR]

 

[Haluk]

Merhaba Ömer Bey,

Nazik mesajınız için teşekkür ederim. Excel ile ilgilenmeyeli 6-7 yıl oluyor, baktim ki epeyce unutmuşum ..... hatırlamak için forumlara uğruyorum. Görüyorum ki, başta sizler olmak üzere bir çok kişi kendini geliştirmiş. Buna çok sevindim.

Diğer yandan; öneriniz bana da mantıklı geldi. Sonuçta satırların yarısı siliyoruz, neden hepsi için döngüde vakit harcayalım diyorsunuz.

Ayrıca, her satır silindiğinde noA'yı yeniden hesaplamak da bir alternatif olabilir ama; her döngüde bu değişkenin yeniden hesaplanması, kodun çalışma süresini uzatabilir.

Sub Test3()
    For i = 0 To Range("A" & Rows.Count).End(xlUp).Row
        Rows(i + 1).Delete
    Next
End Sub

Belki de, yukarıdaki kodların herbirine bir Timer ekleyip en kısa sürede hangisi hesaplıyor.... ona bakmak da iyi olabilir.


.

 

[Orion1]

Haluk hocam.İlk satırla son satırın yerlerini değiştirmek lazım geliyor gibi geldi bana.

Range("A" & Rows.Count).End(xlUp).Row to 1 step -1

 

[Haluk]

Merhaba Evren Bey,

Kodu denemiştim diye hatırlıyorum ama, dedim ya .... Excel'i hafiften unutmuşum, dediğiniz gibi de olabilir.

Bu arada; bir de VBA kullanmadan bir alternatif sunmak istedim.,

Dediğimiz gibi, veriler A sütunundaysa;

1) Yanına bir sütun ilave ediyoruz. (Yeni ilave edilen sütun, "B" sütunu oldu)

2) B1 hücresine aşağıdaki formülü yazıp, A sütunundaki en son dolu hücrenin olduğu satıra kadar sürükleyip, formulü B sütunundaki hücrelere çoğaltıyoruz.

=MOD(ROW();2)

3) Şimdi B sütunu seçip, filtre uyguluyoruz ve sonucu "0" (sıfır) olanları listeletiyoruz.

4) Sayfada, bu satırları seçiyoruz. (Sayfanın en solunda Excel'in satır numaraları yazdığı yerde, aşağıya doğru tarayarak)

5) Seçilen satırları siliyoruz.


.

Not: Türkçe Excel için;
ROW >>>> SATIR
MOD >>>> MOD


.

 

[Korhan Ayhan]

Alternatif olarak satır silme işlemi yerine DİZİ yöntemi ile aynı alana verileri listeleme işlemini deneyebilirsiniz. Böylece çok hızlı bir şekilde sonuç alabilirsiniz.

Aşağıdaki kod "A" sütunu için sonuç üretecektir.

Sub Listele()
    Dim X As Long, Son As Long, Veri As Variant, Zaman As Double, Say As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A1:A" & Son).Value
    ReDim Liste(1 To 1)

    For X = LBound(Veri) To UBound(Veri)
        If X Mod 2 = 0 Then
            Say = Say + 1
            ReDim Preserve Liste(1 To Say)
            Liste(Say) = Cells(X, 1)
        End If
    Next
    
    Range("A:A").Clear
    Range("A1:A" & Say) = Application.Transpose(Liste)
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000") & " Saniye"
End Sub