"Yinelenenleri Kaldır" da, BOŞ hücreleri de kaldırsın

[baydeniro]

Merhaba Arkadaşlar,
Yinelenenleri Kaldır işlemi yapıyoruz. Boş hücreyi dikkate almasa, yani boşluksuz tek listeye döndürmesi mümkün mü ?

 

[kulomer46]

Değerli arkadaşım Merhaba

Aşağıdaki makro Yinelenenleri Kaldır işlemi yapmaktadır.
Yani Excelde seçili alan içindeki değerleri tekrarsız olarak yeniden seçili alana atmaktadır.
Ve bunu yaparken boşluksuz olarak yapmaktadır.
Makro kodu aşağıdadır.
Bu makro kodunu 'PERSONAL' dosyanıza ekleyip sonrada bir düğmeye veya menüye atarsanız tüm excel dosyalarınızda otomatik kullanabilirsiniz.

Kolay Gelsin. Selamlar...

Sub collection_deneme_tekrarlanan_kayıtları_süz()
' 01.12.2011
' 12.03.2020
' Bu program seçili alan içindeki kayıtları benzersiz olarak seçili alan içinde listeler..
'---------------------------------------------------------------------------------

'Collection nesnesini sepet olarak düşünebiliriz. İçine atılan
'nesneleri ayıklayıp, her türden sadece bir çeşit içinde barındırır.

Dim satir, sutun, i, j, k

Dim c
c = MsgBox("Tekrarlanan Kayıtlar silinecek, Emin misiniz?", vbYesNo, "Siliniyor !")
If c = vbNo Then Exit Sub


    Dim col As New Collection ' col değişkeni Collection nesnesi olarak tanımlanıyor..
    Dim rg As Range
    Dim hcr As Range
    Set rg = Intersect(ActiveWindow.Selection, Cells(1, 1).Parent.UsedRange)
    'seçili alan içinde excel tarafından kullanılan hücreler range
    ' olarak tanımlanmış rg nesnesine atılıyor
   
    On Error Resume Next
    For Each hcr In rg.Cells
        If Trim(hcr) <> "" Or hcr <> empyt Then

            col.Add CStr(Trim(hcr)), CStr(Trim(hcr)) 'rg nesnesine atılan
            'hücreler col adlı collection nesnesine atanıyor.
            'Bu değişken türü aynı türde 2. bir değişkeni bünyesinde barındırmaz..
        End If
    Next
   
'Aşağıda benzersiz kayıtları seçili alanda soldan sağa yerleştiren kodlar var..

satir = rg.Rows.Count
sutun = rg.Columns.Count
rg.Clear

For i = 1 To satir
        For j = 1 To sutun
            k = k + 1
            If k > col.Count Then MsgBox "Benzersiz " & col.Count & " adet kayıt var.": Exit Sub
            If col.Item(k) <> "" Or col.Item(k) = Empty Then rg.Cells(i, j) = col.Item(k)
         
        Next
    Next
    MsgBox "Hiç benzer kayıt bulunamadı." & Chr(10) & Chr(10) & "Seviliyorsunuz.  Selamlar..."
   
End Sub

 

[baydeniro]

Değerli arkadaşım Merhaba

Aşağıdaki makro Yinelenenleri Kaldır işlemi yapmaktadır.
Yani Excelde seçili alan içindeki değerleri tekrarsız olarak yeniden seçili alana atmaktadır.
Ve bunu yaparken boşluksuz olarak yapmaktadır.
Makro kodu aşağıdadır.
Bu makro kodunu 'PERSONAL' dosyanıza ekleyip sonrada bir düğmeye veya menüye atarsanız tüm excel dosyalarınızda otomatik kullanabilirsiniz.

Kolay Gelsin. Selamlar...

Sub collection_deneme_tekrarlanan_kayıtları_süz()
' 01.12.2011
' 12.03.2020
' Bu program seçili alan içindeki kayıtları benzersiz olarak seçili alan içinde listeler..
'---------------------------------------------------------------------------------

'Collection nesnesini sepet olarak düşünebiliriz. İçine atılan
'nesneleri ayıklayıp, her türden sadece bir çeşit içinde barındırır.

Dim satir, sutun, i, j, k

Dim c
c = MsgBox("Tekrarlanan Kayıtlar silinecek, Emin misiniz?", vbYesNo, "Siliniyor !")
If c = vbNo Then Exit Sub


    Dim col As New Collection ' col değişkeni Collection nesnesi olarak tanımlanıyor..
    Dim rg As Range
    Dim hcr As Range
    Set rg = Intersect(ActiveWindow.Selection, Cells(1, 1).Parent.UsedRange)
    'seçili alan içinde excel tarafından kullanılan hücreler range
    ' olarak tanımlanmış rg nesnesine atılıyor
  
    On Error Resume Next
    For Each hcr In rg.Cells
        If Trim(hcr) <> "" Or hcr <> empyt Then

            col.Add CStr(Trim(hcr)), CStr(Trim(hcr)) 'rg nesnesine atılan
            'hücreler col adlı collection nesnesine atanıyor.
            'Bu değişken türü aynı türde 2. bir değişkeni bünyesinde barındırmaz..
        End If
    Next
  
'Aşağıda benzersiz kayıtları seçili alanda soldan sağa yerleştiren kodlar var..

satir = rg.Rows.Count
sutun = rg.Columns.Count
rg.Clear

For i = 1 To satir
        For j = 1 To sutun
            k = k + 1
            If k > col.Count Then MsgBox "Benzersiz " & col.Count & " adet kayıt var.": Exit Sub
            If col.Item(k) <> "" Or col.Item(k) = Empty Then rg.Cells(i, j) = col.Item(k)
        
        Next
    Next
    MsgBox "Hiç benzer kayıt bulunamadı." & Chr(10) & Chr(10) & "Seviliyorsunuz.  Selamlar..."
  
End Sub

kulomer46 üstadım elinize, aklınıza sağlık, çok teşekkür ederim. Sağlıcakla kalın

 

[YUSUF44]

Boş hücreleri seçme ve silme yöntemi:

Boşlukları silinecek sütunu seçin (isterseniz satırı ya da belirli bir alanı da seçebilirsiniz)
F5 tuşuna basın
Açılan menüde Özel düğmesine basın
Açılan menüde Boşluklar'ı işaretleyip Tamam deyin
Seçili hücrelerden birine sağ tıklayıp Sil'i seçin
Çıkan seçeneklerden (sadece hücreleri ya da tüm satırı ya da tüm sütunu) uygun olanı seçip işlemi tamamlayın.

 

[baydeniro]

Boş hücreleri seçme ve silme yöntemi:

Boşlukları silinecek sütunu seçin (isterseniz satırı ya da belirli bir alanı da seçebilirsiniz)
F5 tuşuna basın
Açılan menüde Özel düğmesine basın
Açılan menüde Boşluklar'ı işaretleyip Tamam deyin
Seçili hücrelerden birine sağ tıklayıp Sil'i seçin
Çıkan seçeneklerden (sadece hücreleri ya da tüm satırı ya da tüm sütunu) uygun olanı seçip işlemi tamamlayın.

bilgi paylaşımınız için çok teşekkür ederim YUSUF44 üstadım, sağlıcakla kalın

 

[kulomer46]

kulomer46 üstadım elinize, aklınıza sağlık, çok teşekkür ederim. Sağlıcakla kalın

Selamlar...