Çözüldü Sütundaki Tarihleri tek seferde başka sütuna sadece yıl olarak benzesiz ve sıralı aktarma.

[FERAZ]

Merhaba.

Linkteki dosyada açıklama mevcut.

Teşekkürler.

https://www.dropbox.com/s/f02gth4p62trenw/test Tarh.xlsm?dl=0

 

[Korhan Ayhan]

Deneyiniz.

Sub Benzersiz_Sirali_Yil_Listesi()
    Son = Cells(Rows.Count, 1).End(3).Row
    With Range("P1:P" & Son)
        .Formula = "=YEAR(A1)"
        .Value = .Value
    End With
    With Range("P:P")
        .RemoveDuplicates 1, xlNo
        .Sort .Cells(1, 1), xlAscending
    End With
End Sub

 

[FERAZ]

Elinize sağlık.

Acaba formül olayını hiç koda dahil etmeden başka bir yol daha varmı.
Olmazsa bu şekilde kullancağım.

 

[Korhan Ayhan]

Dosyanızda döngü ve ado ile çözüm olmaması konusunda notunuz vardı. Bende hücreleri kullanarak çözüm yoluna gittim. Belki diğer üyelerimizin aklına başka çözümler gelebilir.

 

[FERAZ]

Verdiğiniz formüllü çözümü aslında biliyordum kullanmayı lakin nasıl olduysa aklıma gelmemişti yada benim kafada formülsüz düşünce olduğu için atlamışım.
Formül olayına dosya kasılır diye korkuyorum sonunda value ye çevrilmesine rağmen.Yoksa bu şekildede çok hızlı.Belki diğer yoldanda vardır laki sanmıyorum açıkçası.

Bir soru sorsam şöyleki;
System.collection.arraylist olayında add yöntemi kullanılıp veriler bunun içine alınıyor döngü ile.Sanmıyorum lakin yinede sorayım acaba örneğin A1:A10 aralığını döngüsüz şekilde nasıl collectiona aktarabiliriz.
ToArray olayını denedim malisef olmadı.
Sormamın sebebi arraylist olayında sort var sıralama için.

 

[Ömer BARAN]

Merhaba.
Yanlış düşünmüyorsam aşağıdaki şekilde de sonuç alınabilir.
Mevcut ancak, döngü hücreler üzerinden değil, hafızaya alınan veri yığını üzerinden çalıştığından
veri yığını büyük olduğunda da hız sorununun olmaması gerekir.

Sub BENZERSIZ()
Dim a&, sayi&, liste()
[P:P].ClearContents
liste = Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).Value
With CreateObject("Scripting.Dictionary")
    For a = 1 To UBound(liste)
        If Not .Exists(Year(liste(a, 1))) Then: .Add Year(liste(a, 1)), ""
    Next a
    Range("P1").Resize(.Count, 1).Value = Application.Transpose(.Keys)
End With
sayi = Empty: a = Empty: Erase liste
End Sub

 

[FERAZ]

Merhaba.
Yanlış düşünmüyorsam aşağıdaki şekilde de sonuç alınabilir.
Mevcut ancak, döngü hücreler üzerinden değil, hafızaya alınan veri yığını üzerinden çalıştığından
veri yığını büyük olduğunda da hız sorununun olmaması gerekir.

Sub BENZERSIZ()
Dim a&, sayi&, liste()
[P:P].ClearContents
liste = Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).Value
With CreateObject("Scripting.Dictionary")
    For a = 1 To UBound(liste)
        If Not .Exists(Year(liste(a, 1))) Then: .Add Year(liste(a, 1)), ""
    Next a
    Range("P1").Resize(.Count, 1).Value = Application.Transpose(.Keys)
End With
sayi = Empty: a = Empty: Erase liste
End Sub

Ömer hocam emek vermişşiniz sağolun.
Bana döngüsüz lazımdı.
Döngü ile sizin yöntem için Arraylist olayını tercih ediyorum.Çünkü onda sort yada yanlış yazmazsam reverse vardı büyükten küçüğe doğru.Mobilden kafadan yazdığım için yanlışlık olabilir reverse için.

 

[Korhan Ayhan]

Bahsettiğiniz nesneler "Collection" (Biriktirme) özelliğine sahip oldukları için döngü olmadan tek hamlede verilerin yükleneceğini düşünmüyorum. Bu tarz bir nesne var mıdır bilemiyorum. Varsa bile bu nesnenin hem hücrelerdeki yıl bilgisini alması gerekir hem de benzersiz kayıt ayıklama özelliği olması gerekir.

CreateObject("System.Collections.Arraylist") nesnesinin güzel özellikleri olmasına karşın biraz yavaş çalıştığını söyleyebilirim.
CreateObject("Scripting.Dictionary") nesnesi daha hızlı sonuç vermektedir. Fakat sıralama özelliği yoktur. Siz zaten verileri hücreye yazdırmayı düşündüğünüz için sıralama işleminide döngü sonunda yaparak hız kaybı yaşamamış olursunuz.

Tabi ki kullanım tercihi size kalmış.

İyi forumlar...

 

[FERAZ]

Sağolun Korhan hocam açıklama için.

İyi forumlar.