Tekrar Eden Veriyi Şarta Göre Silme

[cnrclk07]

Merhabalar aranızda yeniyim. Yeni yenide kod yazmaya başladım. Bir kaç yerde takıldım yardımlarınızı bekliyorum.

Rakip analizi yaptığım bir excelde ürün isimlerini aynı olduğunda satırı sildiriyorum. Fakat bazı ürünlerde isim aynı fiyatın farklı olduğunu gördüm. Örnek vermek gerekirse

Ürün adı	Fiyatı
Kalem1	18
Kalem1	18
Kalem2	20
Kalem2	22

yukarıdaki tabloda ben ürün adına göre sildirdiğim için kalem1 de sorunsuz çalışıyor fakat kalem2 de fiyat farklı aslında bunu görmek istiyorum. yani şarta bağlayarak yapmak istiyorum hem isimleri aynı olsun hem fiyatları aynı olsun aşağıda yazmış olduğum kodu bırakıyorum nasıl düzenleme yapmam lazım yardımlarınızı bekliyorum.

sonsatir = Sheets("MarkaVerileri").Range("F65536").End(3).Row
For b = 1 To 15
For i = 1 To sonsatir
If WorksheetFunction.CountIf(Sheets("MarkaVerileri").Range("F1:F" & i), Sheets("MarkaVerileri").Range("F" & i).Value) > 1 Then
Sheets("MarkaVerileri").Rows(i).Delete Shift:=xlUp

End If
Next i
Next

 

[Ömer]

Merhaba,

Eğersay yerine Çokeğersay kullanabilirsiniz.

- Satır silme işlemlerinde bu yöntemi kullanacaksanız döngüyü tersten başlatmanız daha doğru olacaktır.
- b döngüsü bu işlem için gereksiz olduğundan pasifleştirdim. Eğer farklı bir işlemde kullanıyorsanız aktif yaparsınız.
- Sayfa adını S1 olarak tanımladım.
- Fiyatı G sütununda düşünerek yazdım.

Set S1 = Sheets("MarkaVerileri")
sonsatir = S1.Range("F65536").End(3).Row
'For b = 1 To 15
'For i = 1 To sonsatir
For i = sonsatir To 1 Step -1
'If WorksheetFunction.CountIf(Sheets("MarkaVerileri").Range("F1:F" & i), Sheets("MarkaVerileri").Range("F" & i).Value) > 1 Then
If WorksheetFunction.CountIfs(S1.Range("F1:F" & i), S1.Range("F" & i).Value, S1.Range("G1:G" & i), S1.Range("G" & i).Value) > 1 Then
Sheets("MarkaVerileri").Rows(i).Delete Shift:=xlUp

End If
Next i
'Next

 

[cnrclk07]

Merhaba,

Eğersay yerine Çokeğersay kullanabilirsiniz.

- Satır silme işlemlerinde bu yöntemi kullanacaksanız döngüyü tersten başlatmanız gerekir.
- b döngüsü bu işlem için gereksiz olduğundan pasifleştirdim. Eğer farklı bir işlemde kullanıyorsanız aktif yaparsınız.
- Sayfa adını S1 olarak tanımladım.
- Fiyatı G sütununda düşünerek yazdım.

Set S1 = Sheets("MarkaVerileri")
sonsatir = S1.Range("F65536").End(3).Row
'For b = 1 To 15
'For i = 1 To sonsatir
For i = sonsatir To 1 Step -1
'If WorksheetFunction.CountIf(Sheets("MarkaVerileri").Range("F1:F" & i), Sheets("MarkaVerileri").Range("F" & i).Value) > 1 Then
If WorksheetFunction.CountIfs(S1.Range("F1:F" & i), S1.Range("F" & i).Value, S1.Range("G1:G" & i), S1.Range("G" & i).Value) > 1 Then
Sheets("MarkaVerileri").Rows(i).Delete Shift:=xlUp

End If
Next i
'Next

Ömer Bey Çok teşekkür ederim. Tam istediğim gibi oldu hatamı anlamış oldum. Sizden bir ricam daha olacak umarım sizi yormuyorumdur.
Bu veriyi sadeleştirdikten sonra başka bir sayfaya kaydediyorum. Haftalık bu işi yapıyorum bazı kategorilerde aynı ürün seçilebiliyor. Örneğin indirimli ürünler kategorisinde kalem1 var 0.7 uçlu kalemler kategorisinde de kalem1 var bunlar kayıt sayfamda tekrara düşüyor. Tablo olarak açıklayım.

Tarih	Ürün Adı	Fiyat
10.05.2022	kalem1	13
10.05.2022	kalem2	15
11.05.2022	kalem1	20
11.05.2022	kalem1	20

Yukarısı kayıt sayfam. Burada bugünün tarihine bakarak yenilenen değerleri silmek istiyorum. Dün kaydettiğim kalem1 kalsın fakat bugün çektiğim kalem1 iki defa tekrar etmiş bunun sebebi de farklı kategoride kalem1 ürünün olmasıdır. Kısacası burada da tarihe göre tekrar eden veriyi silmek istiyorum sizin kodu uyarlayım bu alan için olmadı.

 

[Ömer]

Örnek bir excel dosyası hazırlayıp dosya içerisinde gerekli açıklamaları örnekleri ile yaparak açıklamanızı rica ederim. Aşağıdaki paylaşım sitesine dosyanızı yükleyip linki paylaşabilirsiniz.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

.

 

[cnrclk07]

Örnek bir excel dosyası hazırlayıp dosya içerisinde gerekli açıklamaları örnekleri ile yaparak açıklamanızı rica ederim. Aşağıdaki paylaşım sitesine dosyanızı yükleyip linki paylaşabilirsiniz.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

.

örneği yükledim. Makro kodunu makro olarak değil metin kısmına yazdım.

İndir örnek1

Dosyayı indir örnek1

dosya.co

 

[Ömer]

Aynı yöntemi kullanarak çokeğersay'a ekleme yaptım. A, B, C, D sütunlarının tekrarlığı kontrol edilerek silinir.

Sub Sil()

    Dim S1 As Worksheet, sonsatir As Long, i As Long
   
    Set S1 = Sheets("MarkaVerileri")
    sonsatir = S1.Range("C65536").End(3).Row
   
    Application.ScreenUpdating = False
   
    For i = sonsatir To 1 Step -1
        If WorksheetFunction.CountIfs(S1.Range("A1:A" & i), S1.Range("A" & i).Value, _
            S1.Range("B1:B" & i), S1.Range("B" & i).Value, _
            S1.Range("C1:C" & i), S1.Range("C" & i).Value, _
            S1.Range("D1:D" & i), S1.Range("D" & i).Value) > 1 Then
            S1.Rows(i).Delete Shift:=xlUp
        End If
    Next i
   
     Application.ScreenUpdating = True
   
End Sub

 

[cnrclk07]

Teşekkür ederim sorun çözülmüştür.