Farklı sayfalardaki mükerrer kayıtları silme

nanotech3485 · 14 Aralık 2023

Arkadaşlar merhaba. Gün içerisinde bir excel dosyasında bulunan birden fazla sayfadaki mükerrer kayıtları silme ile alakalı tam istediğim gibi bir konu bulamadım. Bu konu ile ilgili yardımlarınızı bekliyorum.

Örnek dosyamızda birden fazla sayfa (Sayfa1, Sayfa2 ve Sayfa3) bulunuyor ve her bir sayfada 800 bin satır civarında veri var. Amacım A ve H sütunlarını baz alarak tüm sayfalarda bulunan mükerrer kayıtlardan bir tanesini bırakıp diğerlerini silmek. Excel her bir sayfada max. 1M satır sınırı olduğundan dolayı verileri sayfalara bölüyorum. Yani Tüm sayfalardaki veriler birbirinin devamı olduğundan dolayı mükerrer olanları silmek istiyorum. Eğer mümkünse biraz işlemin uzun sürebileceğini düşündüğümden dolayı "Progress Bar" eklenebilir mi? İşlemin devam etme yüzdesini de görebilmemiz mümkün olur mu? Yüzbinlerce veri olduğundan dolayı bu işlemi hızlı yapabileceğim bir makro arayışı içerisindeyim. Bu konu ile alakalı yardımlarınızı bekliyorum. Şimdiden çok teşekkür ederim.

Örnek dosyayı link ile paylaşıyorum.
https://dosya.co/5fnf5iuftx53/data-us.xlsx.html

nanotech3485 · 15 Aralık 2023

Arkadaşlar tekrar merhaba, yardımcı olabilecek kimse yok mu acaba?

ÖmerBey · 15 Aralık 2023

Merhaba,
Dosyanızın yedeğini aldıktan sonra deneyiniz.
ProgressBar yok, kodları bir deneyin istediğiniz sonucu verirse sonradan da eklenebilir.

Kod:

Sub kod()
Dim s As Object
Dim sh As Worksheet
Dim a As Long
Dim sil As Range
Set s = CreateObject("Scripting.Dictionary")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each sh In Sheets
    Set sil = sh.Cells(Rows.Count, "A")
    For a = 2 To sh.Cells(Rows.Count, 1).End(3).Row
        If s.exists(sh.Cells(a, "A") & sh.Cells(a, "H")) Then
            Set sil = Union(sil, sh.Cells(a, "A"))
        Else
            s.Add sh.Cells(a, "A") & sh.Cells(a, "H"), 1
        End If
    Next
    sil.EntireRow.Delete
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Erkan Akayay · 16 Aralık 2023

ÖmerBey' Alıntı:

Merhaba,
Dosyanızın yedeğini aldıktan sonra deneyiniz.
ProgressBar yok, kodları bir deneyin istediğiniz sonucu verirse sonradan da eklenebilir.

Kod:

Sub kod()
Dim s As Object
Dim sh As Worksheet
Dim a As Long
Dim sil As Range
Set s = CreateObject("Scripting.Dictionary")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each sh In Sheets
    Set sil = sh.Cells(Rows.Count, "A")
    For a = 2 To sh.Cells(Rows.Count, 1).End(3).Row
        If s.exists(sh.Cells(a, "A") & sh.Cells(a, "H")) Then
            Set sil = Union(sil, sh.Cells(a, "A"))
        Else
            s.Add sh.Cells(a, "A") & sh.Cells(a, "H"), 1
        End If
    Next
    sil.EntireRow.Delete
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Ömer Bey'in çözümü çok güzel. Problem olabilecek bir detay var.
A ve H arası sütunların hepsini kontrol etmiyor. Karşılaştırmaya A ve H olarak iki sütun alıyor.
Bu iki sütun yeterli ise problem yok.

nanotech3485 · 16 Aralık 2023

ÖmerBey' Alıntı:

Merhaba,
Dosyanızın yedeğini aldıktan sonra deneyiniz.
ProgressBar yok, kodları bir deneyin istediğiniz sonucu verirse sonradan da eklenebilir.

Kod:

Sub kod()
Dim s As Object
Dim sh As Worksheet
Dim a As Long
Dim sil As Range
Set s = CreateObject("Scripting.Dictionary")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each sh In Sheets
    Set sil = sh.Cells(Rows.Count, "A")
    For a = 2 To sh.Cells(Rows.Count, 1).End(3).Row
        If s.exists(sh.Cells(a, "A") & sh.Cells(a, "H")) Then
            Set sil = Union(sil, sh.Cells(a, "A"))
        Else
            s.Add sh.Cells(a, "A") & sh.Cells(a, "H"), 1
        End If
    Next
    sil.EntireRow.Delete
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Hocam merhaba; elinize sağlık test dosyasında 100'er adet veri üzerinde denedim ve düzgün çalıştığını gözlemledim. Orjinal dosyamda birkaç milyon veri mevcut, orada deneyeyim dedim, 15-20dk denedim. Galiba işlem devam ediyor ama Progress Bar ekleyebilir misiniz rica etsem? Bu tarz büyük boyutlu dosyalarda en azından işlemin hangi yüzdede olduğunu görebilirim.

Aslında çok teşekkür ediyorum çünkü bu işlemi tek sefer değil devamlı uygulayacağımdan dolayı çok işime yarayacak hocam. Tekrar elinize sağlık.

alicimri · 16 Aralık 2023

Bu kadar çok veriniz varsa niye Excel ile uğraşıyorsunuz. Örneğin Access ile kolay çözüm bulursunuz.

nanotech3485 · 16 Aralık 2023

alicimri' Alıntı:
Bu kadar çok veriniz varsa niye Excel ile uğraşıyorsunuz. Örneğin Access ile kolay çözüm bulursunuz.

Merhaba, Access ile daha önce hiç çalışmadım hocam. Tüm düzenlenmeleri ve makroları Excel üzerinde aktif birşekilde yönetebiliyorum. İlk 1M veriye kadar sorun yok ama 1M veriyi geçtiği zaman duplicate kayıtlar sorun olmaya başladı.

Erkan Akayay · 16 Aralık 2023

nanotech3485' Alıntı:
Merhaba, Access ile daha önce hiç çalışmadım hocam. Tüm düzenlenmeleri ve makroları Excel üzerinde aktif birşekilde yönetebiliyorum. İlk 1M veriye kadar sorun yok ama 1M veriyi geçtiği zaman duplicate kayıtlar sorun olmaya başladı.

Hassas veriyse tekrar ediyorum. İlk ve son sütuna bakıyor. Aradaki 6 sütun karşılaştırmaya girmiyor. Aradaki 6 sütundan birini değiştirip deneyin. Onuda mükerrer diye silecektir.

alicimri · 16 Aralık 2023

Verileri nasıl alıyorsunuz ve bu verilerle ne işlemler yapıyorsunuz.
Verileri Access te tutup, Excel de işlem yapabilirsiniz.

nanotech3485 · 16 Aralık 2023

Erkan Akayay' Alıntı:
Hassas veriyse tekrar ediyorum. İlk ve son sütuna bakıyor. Aradaki 6 sütun karşılaştırmaya girmiyor. Aradaki 6 sütundan birini değiştirip deneyin. Onuda mükerrer diye silecektir.

Merhaba hocam. Evet farkındayım A ve H sütununa göre karşılaştırma yapmasını özellikle istiyorum. Evet arada kalan sütunların aynı veya farklı olması farketmez bizim için. A ve H Sütunu aynı olan kayıtlardan sadece 1 tanesini burakıp diğerlerini siliyor. Şu an tam istediğim gibi ama şu an işlemin hangi aşamada olduğunu görmem lazım açıkçası. Progress Bar eklenebilirse eğer tam istediğim gibi olacak hocam.

ÖmerBey · 16 Aralık 2023

Tekrar merhaba,
Yukarıdaki kodların ProgressBar eklenmiş hali ektedir, inceleyiniz...
Harici Link

Necdet · 16 Aralık 2023

Merhaba,

Ömer Bey'in kodlarına biraz array karıştırınca süre olarak biraz kısalma oldu, sizin büyük verilerinizde de biraz farkedebilir.
Deneyiniz, sonucu merak ediyorum.

Kod:

Sub Deneme()

Dim s As Object
Dim sh As Worksheet
Dim a As Long
Dim sil As Range
Dim bsTimer As Double
Dim adt As Long
Dim arr As Variant
Dim deg As String

bsTimer = Timer

Set s = CreateObject("Scripting.Dictionary")

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

For Each sh In Sheets
    arr = sh.Range("A1").CurrentRegion.Value
    Set sil = sh.Cells(UBound(arr, 1), "A")
    For a = 2 To UBound(arr, 1)
         Application.StatusBar = sh.Name & " " & a
        deg = Left(arr(a, 1), 3) & Right(arr(a, 1), 3) & _
              Left(arr(a, 8), 3) & Right(arr(a, 8), 3)
        If s.exists(deg) Then
            Set sil = Union(sil, sh.Cells(a, "A"))
            adt = adt + 1
        Else
            s.Add deg, 1
        End If
    Next
    sil.EntireRow.Delete
Next

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

MsgBox adt & " Adet Veri : " & Timer - bsTimer & " Sürede İşlem  Tamamlanmıştır..."

End Sub

nanotech3485 · 17 Aralık 2023

ÖmerBey' Alıntı:
Tekrar merhaba,
Yukarıdaki kodların ProgressBar eklenmiş hali ektedir, inceleyiniz...
Harici Link

Hocam merhaba, progress bar'ın olması iyi oldu. Teşekkürler. İlk sayfada 1M kayıt, ikinci sayfada 300 bin kayıt ile test ettim. Acaba daha da hızlı bir şekilde derleme yapılabilir mi sizce? Yaklaşık 2 saatte 2. sayfadan 90bin veri işlendi. Çok yavaş gidince bende durdurmak durumunda kaldım. Çok teşekkürler elinize sağlık.

nanotech3485 · 17 Aralık 2023

Necdet' Alıntı:

Merhaba,

Ömer Bey'in kodlarına biraz array karıştırınca süre olarak biraz kısalma oldu, sizin büyük verilerinizde de biraz farkedebilir.
Deneyiniz, sonucu merak ediyorum.

Kod:

Sub kod2()

Dim s As Object
Dim sh As Worksheet
Dim a As Long
Dim sil As Range
Dim bsTimer As Double
Dim adt As Long
Dim arr As Variant

bsTimer = Timer

Set s = CreateObject("Scripting.Dictionary")

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

For Each sh In Sheets
    arr = sh.Range("A1").CurrentRegion.Value
    Set sil = sh.Cells(UBound(arr, 1), "A")
    For a = 2 To UBound(arr, 1)
        If s.exists(arr(a, 1) & arr(a, 8)) Then
            Set sil = Union(sil, sh.Cells(a, "A"))
            adt = adt + 1
        Else
            s.Add arr(a, 1) & arr(a, 8), 1
        End If
    Next
    sil.EntireRow.Delete
Next

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

MsgBox adt & " Adet Veri : " & Timer - bsTimer & " Sürede İşlem  Tamamlanmıştır..."

End Sub

Necdet Bey merhaba; Ömer Bey'in kodlarına yaptığınız düzenlemeyi test edebilmek adına rica etsem Progress Bar eklemeniz mümkün olur mu acaba? Hızı böylece test edebilirim. Teşekkür ederim.

Necdet · 17 Aralık 2023

Merhaba,

ProgresBar ı boşverin 12 nolu mesajdaki kodu değiştirdim.
Bir deneyin ve sonucu da söylerseniz memnun olurum.
Tabi dosyanın yedeğini almadan denemeyiniz.

nanotech3485 · 17 Aralık 2023

Necdet' Alıntı:
Merhaba,

ProgresBar ı boşverin 12 nolu mesajdaki kodu değiştirdim.
Bir deneyin ve sonucu da söylerseniz memnun olurum.
Tabi dosyanın yedeğini almadan denemeyiniz.

Hocam merhaba, kod için çok teşekkürler. yaklaşık olarak 1 saattir çalışıyor fakat işlemin durumunu takip edemediğimden dolayı yavaş mı hızlı mı ne aşamada göremiyorum. ProgressBar'ı bu yüzden istemiştim açıkçası. Çünkü 1M den fazla veri olunca ister istemez işlemin ne durumda hangi aşamada olduğunu görmek biraz daha önem kazanıyor benim açımdan.

Necdet · 17 Aralık 2023

ben her sayfayı yaklaşık 350 bin kayıtla denedim, baya hızlı idi.
sizin verilerinizin kayıt sayısı nedir?

nanotech3485 · 17 Aralık 2023

Necdet' Alıntı:
ben her sayfayı yaklaşık 350 bin kayıtla denedim, baya hızlı idi.
sizin verilerinizin kayıt sayısı nedir?

Necdet hocam 2 sayfa mevcut. ilk sayfa 1Milyon, ikinci sayfa 300 bin adet. Sonrakş dönemlerde daha büyük verilerde işleme alacağım. Şu an hala işlem devam ediyor. 8 çekirdek 3.70Ghz i7 işlemci. M2 SSD disk ve 16GB DDR4 bilgisayarda test ediliyor şu an. Düzenli olarak kullanacağım hız performansı oldukça önemli hocam. O yüzden hangi aşamada olduğunu görebilsem bir hız raporu verebilirim sizlere de.

Necdet · 18 Aralık 2023

Sizin bilgisayar benimkinden daha iyi.
iki sayfadaki verileri çoğalttım 1 Milyon satır oldu, toplam 2 milyon küsur satırda denedim ve Sonuçta 5 dakika sürdü.
12 Nolu mesajdaki benim verdiğim kodları denediniz m?
Excelin Status Bar ına okunan sayfa ve satır numarasını yazdırdım.
12 nolu mesajdan kodları yeniden alınız.
Bu konu artık benim için kapandı.

Farklı sayfalardaki mükerrer kayıtları silme

nanotech3485

nanotech3485

ÖmerBey

Destek Ekibi

Erkan Akayay

nanotech3485

alicimri

nanotech3485

Erkan Akayay

alicimri

nanotech3485

ÖmerBey

Destek Ekibi

Ekli dosyalar

Necdet

Moderatör

nanotech3485

nanotech3485

Necdet

Moderatör

nanotech3485

Necdet

Moderatör

nanotech3485

Necdet

Moderatör