DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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ınDeğ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...
Kod: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
bilgi paylaşımınız için çok teşekkür ederim YUSUF44 üstadım, sağlıcakla kalınBoş 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.
Selamlar...kulomer46 üstadım elinize, aklınıza sağlık, çok teşekkür ederim. Sağlıcakla kalın