Mükerrer Kayıt Silme

[Altay3555]

Öncelikle selamlar,
ara verince unutuluyor mu ne,bir yardıma ihtiyacım var ve;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For a = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) > 1 Then Rows(a).Delete
Next
End Sub


Burada araması/silmesi gereken "A" sütunu iken neden yapmıyor.daha doğrusu "B" de siliniyor.

 

[Orion1]

Deneyiniz.

If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) > 1 Then [B][COLOR="Red"]Range("A" & a).Delete (xlUp)[/COLOR][/B]

 

[Altay3555]

Hocam,öncelikle cevabınıza teşekkürler.
Formül güzel bir şekilde çalıştı,bir soru olarak
Bu "A" hücresindeki mükerrer kayıtları temizliyor,"B" hücresinde benzersiz bir kayıt olsa,bu kaydı "A" hücresine ekleyebilirmiyiz.

 

[Orion1]

Hocam,öncelikle cevabınıza teşekkürler.
Formül güzel bir şekilde çalıştı,bir soru olarak
Bu "A" hücresindeki mükerrer kayıtları temizliyor,"B" hücresinde benzersiz bir kayıt olsa,bu kaydı "A" hücresine ekleyebilirmiyiz.

Anlamadım.
Örnek dosya ekleyip onun üzerinde açıklarmısınız?

 

[irtemonogirt]

cari hesap

Konu ile ilgisi yok ama exel de basit bir cari hesap hazirlicam yardımcı olun lütfen ( özel mesaja yazarsanız daha çabuk çözüm alırım. Acil

 

[Altay3555]

Konu ile ilgisi yok ama exel de basit bir cari hesap hazirlicam yardımcı olun lütfen ( özel mesaja yazarsanız daha çabuk çözüm alırım. Acil

Arama kısmına "cari hesap" yazarsanız onlarca örnek dosya var basitinden mükemmeline kadar...

 

[Altay3555]

Hocam dosyayı ekledim.

 

[Orion1]

Hocam dosyayı ekledim.

Dosyanız ektedir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J9]) Is Nothing Then Exit Sub
Dim sat As Long, i As Long, sat2 As Long
Sheets("Sayım").Select
Range("K9:M" & Rows.Count).ClearContents
Application.ScreenUpdating = False
sat = Cells(Rows.Count, "B").End(xlUp).Row
sat2 = 9
For i = 2 To sat
    If Cells(i, "B").Value = Cells(9, "J").Value Then
        Cells(sat2, "K").Value = Cells(i, "E").Value
        Cells(sat2, "L").Value = Cells(i, "F").Value
        Cells(sat2, "M").Value = Cells(i, "H").Value
        sat2 = sat2 + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName

End Sub

 

[Altay3555]

Hocam çok teşekkürler..
Emeğinize sağlık.

 

[Orion1]

Hocam çok teşekkürler..
Emeğinize sağlık.

Baktığınızda mükerrer kayıtlar gösteriyordu.
Sanırım onlar teke inecekti.
Alttaki mükerereri teke indiren dosyayı yaptım.
Birde bunu deneyin.belkide bunu istediniz.
Dosya ektedir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J9]) Is Nothing Then Exit Sub
Dim sat As Long, i As Long, sat2 As Long
Dim z As Object
Sheets("Sayım").Select
Range("K9:M" & Rows.Count).ClearContents
Application.ScreenUpdating = False
sat = Cells(Rows.Count, "B").End(xlUp).Row
sat2 = 9
Set z = CreateObject("scripting.dictionary")
For i = 2 To sat
    If Cells(i, "B").Value = Cells(9, "J").Value Then
        deg = Cells(i, "E").Value & "-" & Cells(i, "F").Value
        If Not z.exists(deg) Then
            z.Add deg, Nothing
            Cells(sat2, "K").Value = Cells(i, "E").Value
            Cells(sat2, "L").Value = Cells(i, "F").Value
            Cells(sat2, "M").Value = Cells(i, "H").Value
            sat2 = sat2 + 1
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName

End Sub

 

[Altay3555]

Hocam teşekkür ederim.

 

[Orion1]

Hocam çok fazla zahmet olmasın diye basite indirgemiştim.
İsteğim "B" sütununda listeleyeceğim listemde (25 bin veri) servisi seçtiğimde
o servise ait seçtiğim tüm cihazları listelemesi,Mükerrer kayıt engelleme sadece açılır kutuda olması,yoksa A servisinde 5 klima varsa (marka model aynı da olsa) listelemek.
(Dahiliye1 de 5 klima olması gerekirken 4 klima görünmesi!)
Affınıza sığınarak yazıyorum.

Yani her 2 kodda olmadı.ilk yazdığım olacak ama açılır listede mükerer li,stelemeyi engellemek.doğrumudur?
Ama orası b sütunundan değil ,a sütunundan veri alıyor.siz a sütunundada mükerere veri girişi yapmamışsınız.

 

[Altay3555]

(Dahiliye1 de 5 klima olamsı gerekirken 4 klima görünmesi)....
ibaremizi geri alabiliriz.yanlış yazdım.
Netice olarak A sütunu yok sayılarak B sütundaki verileri mükerrer kayıt olmadan açılır kutuya almak...
(B'ya yapılacak kayıtlar da onlarca malzeme aynı servise verileceği için orası lazım.)
Sorun bu...

 

[Altay3555]

Yani her 2 kodda olmadı.ilk yazdığım olacak ama açılır listede mükerer li,stelemeyi engellemek.doğrumudur?
Ama orası b sütunundan değil ,a sütunundan veri alıyor.siz a sütunundada mükerere veri girişi yapmamışsınız.

Bir de şu var ki,yukarıdaki ifade sistem arka planından alınma yoksa,bu mesajdan sonra (ya da içine) teşekkür mesajım vardı..