Benzersiz sıralama yapmak

[CenTay]

Selamlar arkadaşlar d4:ı43 arasındaki verileri k7 den itibaren benzersiz nasıl sıralatabilrim Teşekkürler

 

[YUSUF44]

Formülsüz çözüm için, kopyala, yapıştır, yinelenenleri kaldır, sırala yöntemlerini kullanabilirsiniz. Formüllü çözümü ben bilmiyorum. Makrolu çözüm için ise bu yöntemi makro kaydet yöntemiyle yapıp düzenleyebilirsiniz.

 

[sakman26]

selam,
alternatif olarak,
Makro ve KTF ile çözüm ektedir. İncelersiniz..

Makro ile

Sub Liste()
Application.ScreenUpdating = False
    Set dict = CreateObject("Scripting.Dictionary")
    Range("K7:K" & [K7].End(xlDown).Row).ClearContents
    a = Range("D4:i43").Value
        For Each b In a
        [COLOR="Red"]If b <> "" Then[/COLOR]
            dict(b) = ""
        [COLOR="red"]End If[/COLOR]
        Next b
    [K7].Resize(dict.Count, 1) = Application.Transpose(dict.keys)
Application.ScreenUpdating = True
End Sub

KTF ile (KTF kullanımı İNDİS fonksiyonu ile)

Function Benzersiz(Alan As Range)
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Alan
    If Not d.Exists(c.Value) And c.Value <> "" Then d.Add c.Value, c.Value
  Next c
  Benzersiz = Application.Transpose(d.items)
End Function

 

[CenTay]

Formülsüz çözüm için, kopyala, yapıştır, yinelenenleri kaldır, sırala yöntemlerini kullanabilirsiniz. Formüllü çözümü ben bilmiyorum. Makrolu çözüm için ise bu yöntemi makro kaydet yöntemiyle yapıp düzenleyebilirsiniz.

Teşekkürler cevap ve Öneri için.

 

[CenTay]

selam,
alternatif olarak,
Makro ve KTF ile çözüm ektedir. İncelersiniz..

Makro ile

Sub Liste()
Application.ScreenUpdating = False
    Set dict = CreateObject("Scripting.Dictionary")
    Range("K7:K" & [K7].End(xlDown).Row).ClearContents
    a = Range("D4:i43").Value
        For Each b In a
            dict(b) = ""
        Next b
    [K7].Resize(dict.Count, 1) = Application.Transpose(dict.keys)
Application.ScreenUpdating = True
End Sub

KTF ile (KTF kullanımı İNDİS fonksiyonu ile)

Function Benzersiz(Alan As Range)
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Alan
    If Not d.Exists(c.Value) And c.Value <> "" Then d.Add c.Value, c.Value
  Next c
  Benzersiz = Application.Transpose(d.items)
End Function

Teşekkür Sakman26 ktf listede boşluk olduğunda hata veriyor makro da boşluk varsa (D sütununda) 1 satır boş verip sıralıyor.tabi yine ben hata yapıp verilerin arasında boşluk olabiliyor demedim.Özür, böyle de idare eder.tekrar Sağol.

 

[sakman26]

rica ederim..
kolay gelsin..

 

[sakman26]

KTF kullanımı ile ilgili olarak

İNDİS + KTF kullanımında , benzersiz adedi hesaplattırarak sıra no verip kullanılmasında
Benzersiz adet : N15 hücresindeki formülü

=TOPLA.ÇARPIM(EĞER($D$4:$I$43<>"";1/EĞERSAY($D$4:$I$43;$D$4:$I$43)))

DİZİ formülü ile değiştirin. Bir önceki formülde, hücrelerde BOŞLUK olması dikkate alınmamıştı. Bu formülde dikkate alınmaktadır. KTF de zaten dikkate alınıyor. Formül değişikliği yaptığınızda Normal şekilde çalışacaktır.

Ayrıca indis, Benzersiz adet formülleri olmadan direkt olarak da kullanabilirsiniz. Ama burada benzersiz adet bilinmediğinden, biraz zorluk var. Örneğin 20 satır seçersiniz ve formül bara

=Benzersiz($D$4:$I$43)

yazıp CTRL+SHIFT+ENTER ile giriş yaparsınız (Dizi formülüdür)

fazlalık olursa fazlalıklarda #YOK yazacaktır.
Ya da yukarıdaki formül ile benzersiz adet hesaplatıp o kadar satır seçip dizi formül şeklinde girersiniz.

Makro ile ilgili olarak da
#3 no lu mesajda gerekli düzeltmeleri kırmızı ile belirttim..

Not : Bu duruma uygun ek, #3 mesajda güncellendi.

 

[bzace]

Merhabalar,
Yerleşik işlevler ile alternatif olsun.
Kontrol yapmam için satır sayısını kısa tuttum.
Yanlışlık varsa bakmaya çalışırız.

=EĞER(BAĞ_DEĞ_DOLU_SAY(K$6:K6)-1
  <TOPLA(EĞER(ESAYIYSA(1/EĞERSAY(D$4:I$13;D$4:I$13));1/
    EĞERSAY(D$4:I$13;D$4:I$13)));
      İNDİS(D$4:I$13;MİN(EĞER(DEĞİL(EĞERSAY(K$6:K6;D$4:I$13))*
        UZUNLUK(D$4:I$13);SATIR($1:$10));3^38);
      MOD(MİN(EĞER(DEĞİL(EĞERSAY(K$6:K6;D$4:I$13))*
    UZUNLUK(D$4:I$13);SATIR($1:$10)+
  SÜTUN(A:F)%%));1)/1%%);"")
[COLOR="Blue"]Formül dizi formülüdür.CTRL+SHIFT+ENTER ile tamamlayınız.[/COLOR]

Saygılar,
Şeşen

 

[CenTay]

Selamlar Sakman26 Sağol çözümünüz işimi gördü.Teşekkürler

 

[CenTay]

Selamlar bzace alternatif çözüm ve ilgi için teşekkürler