Tekrar eden metinlerin listesini oluşturma

[vsexcel]

Selam arkadaşlar,
bir çalışma sayfasında birden fazla geçen aynı metinleri diğer bir çalışma sayfasında liste halinde nasıl gösterebilirim.Aynı zamanda yeni bir eklenti yaptığımda listedede otomatik olarak çıkmasını istiyorum.
yapmak isteğimi ekli dosyada bulabilirsiniz.
şimdiden teşekkür ederim....

 

[Ömer]

Merhaba,

Dosyanız ektedir.

Forumda bununla ilgili bir çok örnek vardır.Aşağıdaki linki inceleyiniz.

Mükerrer

 

[Orion1]

Dosyanız ekte.

Sub mukerrer()
Dim a, n As Long, i As Long, z As Object
Set s1 = Sheets("veri tabanı")
'*******************************************************
Sheets("liste").Select
Sheets("liste").Range("A1:B65536").Clear
a = s1.Range("A1:A" & s1.Cells(65536, "A").End(xlUp).Row)
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a, 1)
    If Not z.exists(a(i, 1)) Then
        z.Add a(i, 1), 1
    Else
        z.Item(a(i, 1)) = z.Item(a(i, 1)) + 1
    End If
Next i
For Each vKey In z.keys
    If z.Item(vKey) = 1 Then
        z.Remove (vKey)
    End If
Next vKey
Application.ScreenUpdating = False
If z.Count > 0 Then
    [a1].Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
End If
Application.ScreenUpdating = True
'*******************************************************
Set z = Nothing
Set s1 = Nothing
MsgBox "İşlem Tamam"
End Sub

 

[vsexcel]

Çalışıyor çok teşekkür ederim....

 

[vsexcel]

Merhaba evren,
pekala, birde veri tabanındaki girişlerin yanlarındaki sutunda 0 1 2 olsa veya a b c ve aynı koşulu sağlamak şartıyla tekrar etmeyecek şekilde 0 yazanlar liste1'e gitse 1 yazanlar liste 2'ye 3 yazanlarda Liste 3'e....
ne dersin?

 

[Orion1]

Merhaba evren,
pekala, birde veri tabanındaki girişlerin yanlarındaki sutunda 0 1 2 olsa veya a b c ve aynı koşulu sağlamak şartıyla tekrar etmeyecek şekilde 0 yazanlar liste1'e gitse 1 yazanlar liste 2'ye 3 yazanlarda Liste 3'e....
ne dersin?

Ekli dosyayı inceleyiniz.

Sub mukerrer()
Dim a, n As Long, i As Long, z As Object
Set s1 = Sheets("veri tabanı")
'*******************************************************
Sheets("veri tabanı").Select
a = s1.Range("A1:B" & s1.Cells(65536, "A").End(xlUp).Row)
For t = 2 To 4
Set z = CreateObject("Scripting.Dictionary")
    Sheets(t).Select
    Range("A1:B65536").Clear
    For i = 1 To UBound(a, 1)
        If a(i, 2) + 1 = t Then
            If Not z.exists(a(i, 1) & a(i, 2)) Then
                z.Add a(i, 1) & a(i, 2), 1
                Else
                z.Item(a(i, 1) & a(i, 2)) = z.Item(a(i, 1)) + 1
            End If
        End If
    Next i
    For Each vkey In z.keys
    If z.Item(vkey) = 1 Then
        z.Remove (vkey)
    End If
    Next vkey
    If z.Count > 0 Then
        [a1].Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
    End If
    Set z = Nothing
    vkey = 0
Next t
Application.ScreenUpdating = False
Application.ScreenUpdating = True
'*******************************************************
Set z = Nothing
Set s1 = Nothing
MsgBox "İşlem Tamam"
End Sub

 

[vsexcel]

Dosya için teşekkürler ancak bu kez sadece tekrar edenleri listelere taşıyor.Tekrar etmeyenler veri tabanında kalıyor. Excel de formülle yapılması mümün ise tekrar düzüenleyebilir misin?

 

[Orion1]

Dosya için teşekkürler ancak bu kez sadece tekrar edenleri listelere taşıyor.Tekrar etmeyenler veri tabanında kalıyor. Excel de formülle yapılması mümün ise tekrar düzüenleyebilir misin?

Bu durumda her veriden yalnızca 1 defamı listelenecek gibimi
anlamamız gerekiyor.?

 

[Orion1]

Dosya için teşekkürler ancak bu kez sadece tekrar edenleri listelere taşıyor.Tekrar etmeyenler veri tabanında kalıyor. Excel de formülle yapılması mümün ise tekrar düzüenleyebilir misin?

Aşağıdaki satırı 1nci mesajınızda siz yazmışsınız ve o şekilde istemişsiniz.

bir çalışma sayfasında birden fazla geçen aynı metinleri diğer bir çalışma sayfasında liste halinde nasıl gösterebilirim.

 

[vsexcel]

Şu şekilde düşünebilirsiniz. malzeme stoğu tutyorsunuz fakat bazı kalemler genel ihtiyaç malzemelerini oluşturuyor. örneğin havlu kağıt, peçete.Diğer malzemeler ise sizin işinizle ilgili olanlar. Vida, somun vs...
Veri tabanına gelince ne satın alırsanız alın oraya işiliyorsunuz haliyele aynı malzemeden farklı tarihlerde iki kez üç kez beş kez almışsınız.
Stok 1 'de işinizle ilgili olan Birkez alınmış veya birden fazla kez alınmış malzemeler gözüksün fakat tekrar ediyorsa yani birden fazla satın alınmışsa stok listesi olduğu için sadece bir kez gözüksün.
Stok 2 listesinde ise sarf malzemeler (havlu mendil vs...) yine aynı mantık ile...

 

[Orion1]

Aşağıdaki kırmızı satırları siliniz.

Sub mukerrer()
Dim a, n As Long, i As Long, z As Object
Set s1 = Sheets("veri tabanı")
'*******************************************************
Sheets("liste").Select
Sheets("liste").Range("A1:B65536").Clear
a = s1.Range("A1:A" & s1.Cells(65536, "A").End(xlUp).Row)
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a, 1)
    If Not z.exists(a(i, 1)) Then
        z.Add a(i, 1), 1
    Else
        z.Item(a(i, 1)) = z.Item(a(i, 1)) + 1
    End If
Next i
[COLOR="Red"][B]For Each vKey In z.keys
    If z.Item(vKey) = 1 Then
        z.Remove (vKey)
    End If
Next vKey[/B][/COLOR]
Application.ScreenUpdating = False
If z.Count > 0 Then
    [a1].Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
End If
Application.ScreenUpdating = True
'*******************************************************
Set z = Nothing
Set s1 = Nothing
MsgBox "İşlem Tamam"
End Sub

 

[Orion1]

Formülle yapılmış dosyayı ekledim.
Sayın espinojalın yardımınada ayriyetten teşekkür ederim.
İyi çalışmalar.

 

[vsexcel]

Arkadaşlar çok yardımlarınız için teşekkür ederim.
Harikasınız.

 

[Orion1]

Arkadaşlar çok yardımlarınız için teşekkür ederim.
Harikasınız.

Rica ederim.
iyi çalışmalar.