Diğer Sayfadaki Benzersizleri Bul ve Listele

[Korhan Ayhan]

#18 nolu mesajımı revize ettim. Tekrar deneyiniz.

 

[sekhil]

S1.Range("C2:C" & S1.Cells(S1.Rows.Count, 3).End(3).Row).RemoveDuplicates Columns:=3, Header:=xlNo

bu satırda hata veriyor hocam

 

[Korhan Ayhan]

Ben paylaştığınız dosyada kodu deneyip sizinle paylaştım. Kod bende çalışıyor.

Kodu hücreler boşken başlık satırını aktarmaması için aşağıdaki gibi düzenlemek daha sağlıklı olacaktır.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long

    Set S1 = Sheets("Urunler")
    Set S2 = Sheets("StokGirisleri")

    Application.ScreenUpdating = False
    S1.Range("C2:C" & S1.Rows.Count).ClearContents
    Son = S2.Cells(S2.Rows.Count, 4).End(3).Row
    If Son > 1 Then
        S2.Range("D2:D" & Son).Copy S1.Range("C2")
        S1.Range("C2:C" & S1.Cells(S1.Rows.Count, 3).End(3).Row).RemoveDuplicates Columns:=3, Header:=xlNo
    End If
    Application.ScreenUpdating = True

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[asdsxx]

Merhaba,

Sayfa2 nin kod bölümüne kopyalayınız.

Private Sub Worksheet_Activate()

    Dim S1 As Worksheet, d As Object, i As Long, deg
   
    Set S1 = Sheets("Sayfa1")
    Set d = CreateObject("Scripting.Dictionary")
       
    Application.ScreenUpdating = False

    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        deg = S1.Cells(i, "A")
        If deg <> "" Then
            If Not d.exists(deg) Then
                d.Add deg, Nothing
            End If
        End If
    Next i

    Range("H2:H" & Rows.Count).ClearContents
    Range("H2").Resize(d.Count) = Application.Transpose(d.Keys)

End Sub

Ömer Bey Benzersizleri süzmek için kod ararken yukarıdaki sizin çalışmanızı buldum. Çalışmama uyguladım çalıştı ama ben A sütununun tamamını değil de A6 dan başlayarak süzmesini istedim ama farklı denemelerim (A6:6) hep hata verdi.

For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row

        deg = S1.Cells(i, "A")

burada "A" da nasıl bir değişiklik yaparsak istediğim şekilde olur

 

[Korhan Ayhan]

Döngünün başlangıcını değiştirip deneyiniz.

For i = 2

 

[asdsxx]

Döngünün başlangıcını değiştirip deneyiniz.

For i = 2

Korhan Bey ilginize teşekkür ederim.
Döngü başlangıcı sizin dediğiniz gibi başlıyor. Nasıl bir değişiklik yapmam gerekir
Benim dosyada araması gereken sütun "M" sütunu
For i = 2 To S1.Cells(Rows.Count, "M6:M").End(xlUp).Row
deg = S1.Cells(i, "M6")

yapıyorum hata veriyor. M6 dan başlaması için Döngü başlangıcı nasıl olması lazım

 

[Korhan Ayhan]

Bazen kendimi sorguluyorum.. Biz neyi yanlış yapıyoruz diye..

 

[asdsxx]

Bazen kendimi sorguluyorum.. Biz neyi yanlış yapıyoruz diye..

Çok özür dilerim. Anlayamadım. Bir yeri mi atladım...

 

[Korhan Ayhan]

Döngünün başlangıcını değiştirip deneyin ifadesini kullanmıştım. Ayrıca 2 değerini kalın fontlu yapmıştım. Sanıyorum gözünüzden kaçtı.

 

[asdsxx]

Döngünün başlangıcını değiştirip deneyin ifadesini kullanmıştım. Ayrıca 2 değerini kalın fontlu yapmıştım. Sanıyorum gözünüzden kaçtı.

Korhan Bey Tekrar özür dilerim.
Ben de aynı şeyi ifade etmeye çalıştım. Normalde döngünün başlangı 2 ile başlıyor. Ben "For i = 3" yaptım olmadı "For i = 1" yaptım olmadı, hatta 2 yi kaldırdım hep hata verdi. Farklı şekilleri denedim olmayınca ve değiştirip deneyin derken acaba başka bir nokta mı denenecek diye size yazmıştım.

 

[Korhan Ayhan]

Döngüyü 6. satırdan başlatmak istiyorsanız 2 değeri yerine 6 yazmalısınız.

 

[asdsxx]

Döngüyü 6. satırdan başlatmak istiyorsanız 2 değeri yerine 6 yazmalısınız.

Çok Teşekkür ederim. Sizi meşgul ettim. kusura bakmayın.
Kod konusunda çok iyi değilim. bundan dolayı mantığı düşünemedim.

 

[Korhan Ayhan]

O zaman forumun dersane bölümü incelemenizi önereceğim.

https://www.excel.web.tr/threads/doengueler.5325/