Benzer Veriler

[bisesvar]

Merhaba,

Linkteki excel tablosunda açıklama sütunundaki verilerin

Duran
Hareketli
Duran
Hareketli

Şeklinde sıralanmasını istiyorum. Aradaki benzer verilerin silinmesinin kolay yolu var mıdır?

Teşekkür ederim.

https://www.mediafire.com/?3amc4c46q48vob2

 

[anemis]

Resim görünmüyor.

 

[bisesvar]

Fotoğraf eklenmiştir.

 

[Erdem Akdemir]

Dosya ekleseniz daha iyi olmaz mı?

 

[çıtır]

A sütununu seç ,Veri sekmesi,yenilenenleri kaldır.

 

[bisesvar]

A sütununu seç ,Veri sekmesi,yenilenenleri kaldır.

O şekilde yaptığımda sadece ilk 2 veri kalıyor. Dosya ekleyemedim.

 

[ridvanucok]

Örnek excel dosyanızı yükler misiniz? O şekilde kontrol sağlayalım.

 

[bisesvar]

Altın üyelik gerekiyormuş.

 

[Korhan Ayhan]

Dosyanızı paylaşım sitelerine yükleyip link verebilirsiniz.

 

[hopeful]

B kolonu formüllüdür.

İnceleyiniz..

 

[bisesvar]

Link eklendi.

 

[Korhan Ayhan]

Tekrar edenlerin hangisi silinecek?

 

[bisesvar]

Her tekrar eden serinin ilk verisi kalacak diğerleri silinecek.

Örneğin tabloda A2,A3,A20,A21,A24,A25,A46,A47 satırlarının kalması gerekiyor.

Umarım açıklayabilmişimdir.

 

[Korhan Ayhan]

Verilerinizi yedekledikten sonra aşağıdaki kodu deneyiniz.

Option Explicit

Sub Benzerleri_Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    For X = Son To 2 Step -1
        If Cells(X, 1) = Cells(X - 1, 1) Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, 1)
            Else
                Set Alan = Application.Union(Alan, Cells(X, 1))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then
        Alan.EntireRow.Delete
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        MsgBox "Benzer kayıtlar silinmiştir.", vbInformation
    Else
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        MsgBox "Benzer kayıt bulunamadı!", vbExclamation
    End If
End Sub

 

[bisesvar]

Verilerinizi yedekledikten sonra aşağıdaki kodu deneyiniz.

Option Explicit

Sub Benzerleri_Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    For X = Son To 2 Step -1
        If Cells(X, 1) = Cells(X - 1, 1) Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, 1)
            Else
                Set Alan = Application.Union(Alan, Cells(X, 1))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then
        Alan.EntireRow.Delete
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        MsgBox "Benzer kayıtlar silinmiştir.", vbInformation
    Else
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        MsgBox "Benzer kayıt bulunamadı!", vbExclamation
    End If
End Sub

Evet sorunum çözüldü.

Beni büyük zahmetten kurtardınız. Çok teşekkür ederim.