Tekrar eden kayıtlardan birini silmek

Alpay Black · 5 Şubat 2020

ARKADASLAR A SUTUNUNDA TEKRAR EDEN VERILER VAR
BU VERILERIN C - D - E SUTUNUNDA KARSILIGI OLMAYANLARI SILMEK
ISTIYORUM
YARDIMCI OLURMUSUNUZ
dosya ektedir

Korhan Ayhan · 5 Şubat 2020

"Stok Kodu" olmayan kayıtlar var. Bunlar ne olacak?

Alpay Black · 5 Şubat 2020

Korhan Ayhan' Alıntı:
"Stok Kodu" olmayan kayıtlar var. Bunlar ne olacak?

STOK KODU OLMAYANLAR BIRSEY YAPILMAYACAK HOCAM AYNEN KALACAK

caneryamac · 5 Şubat 2020

Merhaba ,

Veri sekmesinden tablosunu seçip, "yenilenenleri kaldır" sizin işinizi görecektir. Kontrolünüzü ric aederim.

Korhan Ayhan · 5 Şubat 2020

Tablonuzu inceledim.

C-D-E bu üç sütun aynı anda boş olan mükerrer kayıtlar mı silinecek? Yoksa bu üç sütundan birisinin boş olması ve mükerrer kayıt olması silinmesi için yeterli mi?

Mesela görselde ki veride hangi satır silinecek?

Alpay Black · 5 Şubat 2020

Korhan Ayhan' Alıntı:
Tablonuzu inceledim.

C-D-E bu üç sütun aynı anda boş olan mükerrer kayıtlar mı silinecek? Yoksa bu üç sütundan birisinin boş olması ve mükerrer kayıt olması silinmesi için yeterli mi?

Mesela görselde ki veride hangi satır silinecek?

Ekli dosyayı görüntüle 213966

hocam 1 satır silinecek yanı c d e sutununda bır verı yoksa sılınsın

Korhan Ayhan · 5 Şubat 2020

Mükerrer olmayıp C-D-E sütunu boş olan kayıtlarda silinsin mi?

Alpay Black · 5 Şubat 2020

Korhan Ayhan' Alıntı:
Mükerrer olmayıp C-D-E sütunu boş olan kayıtlarda silinsin mi?

hayır hocam sadece mukerrer kayıtlar mujerrer olmayanlar duracak

Korhan Ayhan · 6 Şubat 2020

Verilerinizi YEDEKLEYİP aşağıdaki kodu deneyiniz.

C++:

Option Explicit

Sub Kosula_Bagli_Satir_Sil()
    Dim S1 As Worksheet, Son As Long, Veri As Variant, X As Long
    Dim Dizi As Object, Say As Long, Y As Integer, Zaman As Double
    Dim Liste As Variant, Satir As Long, Sutun As Integer
    
    Zaman = Timer
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Set S1 = Sheets("Kritik seviye")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    Veri = S1.Range("A2:Q" & Son).Value
    
    Satir = UBound(Veri, 1)
    Sutun = UBound(Application.Transpose(Veri))
    
    ReDim Liste(1 To Satir, 1 To Sutun)
    
    For X = 1 To Satir
        If Not Dizi.Exists(Veri(X, 1)) Then
            Dizi.Add Veri(X, 1), 1
        Else
            Dizi.Item(Veri(X, 1)) = Dizi.Item(Veri(X, 1)) + 1
        End If
    Next

    For X = 1 To Satir
        If Dizi.Item(Veri(X, 1)) = 1 Then
            Say = Say + 1
            For Y = 1 To Sutun
                Liste(Say, Y) = Veri(X, Y)
            Next
        Else
            If Veri(X, 1) = Empty Then
                Say = Say + 1
                For Y = 1 To Sutun
                    Liste(Say, Y) = Veri(X, Y)
                Next
            Else
                If Veri(X, 3) <> Empty Or Veri(X, 4) <> Empty Or Veri(X, 5) <> Empty Then
                    Say = Say + 1
                    For Y = 1 To Sutun
                        Liste(Say, Y) = Veri(X, Y)
                    Next
                End If
            End If
        End If
    Next
    
    S1.Range("A2:A" & S1.Rows.Count).EntireRow.ClearContents
    S1.Range("A2").Resize(Say, Sutun) = Liste
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Alpay Black · 6 Şubat 2020

Korhan Ayhan' Alıntı:

Verilerinizi YEDEKLEYİP aşağıdaki kodu deneyiniz.

C++:

Option Explicit

Sub Kosula_Bagli_Satir_Sil()
    Dim S1 As Worksheet, Son As Long, Veri As Variant, X As Long
    Dim Dizi As Object, Say As Long, Y As Integer, Zaman As Double
    Dim Liste As Variant, Satir As Long, Sutun As Integer
   
    Zaman = Timer
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
   
    Set S1 = Sheets("Kritik seviye")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    Veri = S1.Range("A2:Q" & Son).Value
   
    Satir = UBound(Veri, 1)
    Sutun = UBound(Application.Transpose(Veri))
   
    ReDim Liste(1 To Satir, 1 To Sutun)
   
    For X = 1 To Satir
        If Not Dizi.Exists(Veri(X, 1)) Then
            Dizi.Add Veri(X, 1), 1
        Else
            Dizi.Item(Veri(X, 1)) = Dizi.Item(Veri(X, 1)) + 1
        End If
    Next

    For X = 1 To Satir
        If Dizi.Item(Veri(X, 1)) = 1 Then
            Say = Say + 1
            For Y = 1 To Sutun
                Liste(Say, Y) = Veri(X, Y)
            Next
        Else
            If Veri(X, 1) = Empty Then
                Say = Say + 1
                For Y = 1 To Sutun
                    Liste(Say, Y) = Veri(X, Y)
                Next
            Else
                If Veri(X, 3) <> Empty Or Veri(X, 4) <> Empty Or Veri(X, 5) <> Empty Then
                    Say = Say + 1
                    For Y = 1 To Sutun
                        Liste(Say, Y) = Veri(X, Y)
                    Next
                End If
            End If
        End If
    Next
   
    S1.Range("A2:A" & S1.Rows.Count).EntireRow.ClearContents
    S1.Range("A2").Resize(Say, Sutun) = Liste
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

hocam sısden rıcam sız dosyada yapıstırırmısınız ben okadar anlamıyorum bu olaylardan

Korhan Ayhan · 6 Şubat 2020

Artık işin bir tarafından başlayın derim.

Dosyanızı açın.
ALT+F11 tuşlarına basıp kod editörünü açın.
INSERT menüsünden MODÜL seçeneğini seçin.
Karşınıza gelen beyaz pencereye verdiğim kodu uygulayın.
Açık pencereyi çarpı işaretinden kapatıp Excel sayfasına geri dönün.
EKLE menüsünden işlem yapacağınız sayfaya buton şeklinde bir şekil ekleyin.
Bu şekil üzerinde sağ tıklayıp makro ata komutuna tıklayın.
Açılan menüden ilgili makroyu seçip tamam deyin.
Dosyanızı F12 tuşu ile farklı kaydet dedikten sonra dosya türünden MAKRO İÇEREN EXCEL DOSYASI biçiminde kaydedin.

Veri kaybı olmaması için bu dosyanızın yedeğini oluşturup kodu öyle deneyiniz.

Alpay Black · 6 Şubat 2020

Korhan Ayhan' Alıntı:
Artık işin bir tarafından başlayın derim.

Dosyanızı açın.
ALT+F11 tuşlarına basıp kod editörünü açın.
INSERT menüsünden MODÜL seçeneğini seçin.
Karşınıza gelen beyaz pencereye verdiğim kodu uygulayın.
Açık pencereyi çarpı işaretinden kapatıp Excel sayfasına geri dönün.
EKLE menüsünden işlem yapacağınız sayfaya buton şeklinde bir şekil ekleyin.
Bu şekil üzerinde sağ tıklayıp makro ata komutuna tıklayın.
Açılan menüden ilgili makroyu seçip tamam deyin.
Dosyanızı F12 tuşu ile farklı kaydet dedikten sonra dosya türünden MAKRO İÇEREN EXCEL DOSYASI biçiminde kaydedin.

Veri kaybı olmaması için bu dosyanızın yedeğini oluşturup kodu öyle deneyiniz.

Hocam elınıze yuregınıze saglık cok tesekkur ederım calıstı.
50 yasından sonra algılamak bıraz zor oluyor kusura bakmayın

Tekrar eden kayıtlardan birini silmek

Alpay Black

Ekli dosyalar

Korhan Ayhan

Administrator

Alpay Black

caneryamac

Korhan Ayhan

Administrator

Alpay Black

Korhan Ayhan

Administrator

Alpay Black

Korhan Ayhan

Administrator

Alpay Black

Korhan Ayhan

Administrator

Alpay Black