aralarinda 1 degerlik fark bulunan satirlari silme

[seorli]

Öncelikle cahilligim icin affiniza siginiyorum. Forumu inceledim bu sorunu cozmeyi denedim ama henüz caylak sayilabilecek seviyede oldugum icin beceremedim.
Elimde ortalama 10 bin satirdan olusan dosyalar mevcut. Bu islemi manuel olarak yapmayi birkac kez denedim ama olduca vakit kaybi oluyor.
Sorunum su;
A sütununda aralarinda 1 degerlik fark bulunan birkac tane deger var. Bunlarin sayisi sabit degil. Silme islemi A sütunundaki 1 degerlik farka göre yapilmasi gerekiyor. Yani her grup icin ilk satir kalicak digerleri silinecek.
Simdiden tesekkürler.

ÖRNEK
12 1 33
13 5 32
14 6 25
15 9 54

66 1 54
67 1 54
68 51 26
69 20 98

150 1 33
151 0 21
152 1 15
153 0 1

 

[systran]

örneğin anlaşılır değil gibi, biraz ayrıntılı anlatır mısın?

 

[Murat OSMA]

Bu kodları kullanabilirsiniz;

Sub Emre()
    Dim i&, ayır, bul As Range
    Application.ScreenUpdating = False
    For i = Range("A65536").End(3).Row To 1 Step -1
        ayır = Split(Cells(i, 1), " ", -1)
        Cells(i, 2) = Mid(ayır(0), 1, Len(ayır(0)))
        If Cells(i + 1, 2) - Cells(i, 2) = 1 Then
            Set bul = Columns(1).Find(Cells(i + 1, 2), , , 2)
            If Not bul Is Nothing Then
               bul.EntireRow.Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
    i = Empty: Erase ayır: Set bul = Nothing
End Sub

Örnek dosyayı da ekliyorum.

 

[seorli]

cok tesekkürler.

 

[Murat OSMA]

Rica ederim, iyi günler.