Mükerrer kayıt silme

[muarrem]

Merhaba arkadaşlar forumdaki diğer konuları inceledim oralardaki makroları ve söylenenleri denedim ama sorunumu çözemedim.

Elimdeki mevcut excelde yaklaşık 30000 satır var ve bu satırlardaki benzer verilerin silinmesini istiyorum ama şu şekilde A satırı sadece A satırı içerisindeki aynı verinin silinmesini. Aynı şekildede diğer satırlarda da kendi içlerinde bu işlemin yapılmasını istiyorum.

 

[muygun]

Merhaba;
A sütunu için;
Sayfanın kod bölümüne yada boş bir modüle;

Sub sill()
Application.ScreenUpdating = False
On Error Resume Next
sonsatir = Range("A65536").End(xlUp).Row + 1
For i = sonsatir To 2 Step -1
If WorksheetFunction.CountIf(Range("a2:a" & sonsatir), Cells(i, "a")) > 1 Then
Cells(i, "a").Delete shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
End Sub

Kodlarını ekleyerek deneyin.
İyi çalışmalar.

 

[systran]

tüm sütunlar için şu kodu deneyiniz. sütun sayısını KIRMIZI olarak belirtilen yerden değiştirebilirsiniz.

Sub TekilDüzelt()
    Dim d As Object, c As Range, k, tmp As String, j, i, ss As Integer
    Const sütun_sayısı = [COLOR="Red"][B]2[/B][/COLOR]      'kodun çalışacağı sütun sayısı
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For j = 1 To sütun_sayısı
        '1:32000 satır aralığında çalışır INTEGER VERI TIPI
        'bu aralıktaki verileri diziye aktar
        ss = Sheets("Sayfa1").Cells(32000, j).End(xlUp).Row
        Set d = CreateObject("scripting.dictionary")
        For i = 1 To ss
            tmp = Trim(Cells(i, j).Value)
            d(tmp) = d(tmp) + 1
        Next i
    
        'sütunu temizle
        Columns(j).ClearContents
            
        'tekil verileri aynı sütuna yaz
        sayaç = 1
        For Each k In d.keys
            Sayfa1.Cells(sayaç, j) = k      'Tekil veri
            sayaç = sayaç + 1
        Next k
        Set d = Nothing                'diziyi yoket
    Next j
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[muarrem]

tüm sütunlar için şu kodu deneyiniz. sütun sayısını KIRMIZI olarak belirtilen yerden değiştirebilirsiniz.

Sub TekilDüzelt()
    Dim d As Object, c As Range, k, tmp As String, j, i, ss As Integer
    Const sütun_sayısı = [COLOR="Red"][B]2[/B][/COLOR]      'kodun çalışacağı sütun sayısı
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For j = 1 To sütun_sayısı
        '1:32000 satır aralığında çalışır INTEGER VERI TIPI
        'bu aralıktaki verileri diziye aktar
        ss = Sheets("Sayfa1").Cells(32000, j).End(xlUp).Row
        Set d = CreateObject("scripting.dictionary")
        For i = 1 To ss
            tmp = Trim(Cells(i, j).Value)
            d(tmp) = d(tmp) + 1
        Next i
    
        'sütunu temizle
        Columns(j).ClearContents
            
        'tekil verileri aynı sütuna yaz
        sayaç = 1
        For Each k In d.keys
            Sayfa1.Cells(sayaç, j) = k      'Tekil veri
            sayaç = sayaç + 1
        Next k
        Set d = Nothing                'diziyi yoket
    Next j
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

hocam kodu çalıştırıyorum ama mükererleri bulup çıkarmıyor.

 

[systran]

Konu Başlığı: Mükerrer Silme
Mesajınızdan alıntı:

bu satırlardaki benzer verilerin silinmesini istiyorum ama şu şekilde A satırı sadece A satırı içerisindeki aynı verinin silinmesini.

"hocam kodu çalıştırıyorum ama mükererleri bulup çıkarmıyor."
mükerrerleri bulup çıkarmıyo derken???
ben mi yanlış anladım?