benzersiz sıralama (veriler yatay yada düşey liste halinde değil)

[modoste]

anladım korhan hocam teşekkür ederim.

 

[Haluk]

Alternatif olarak "Google Sheets" de QUERY fonksiyonu kullanarak veriler edilir, SORT fonksiyonu da ilave edilerek 2. sütun büyükten-küçüğe doğru sıralanabilir.

Resimde görüldüğü gibi, F3 hücresine yazılacak aşağıdaki formül bütün tabloyu hazırlayacaktır.

=SORT(QUERY({A2:A;B2:B;C2:C;D2:D};"Select Col1, Count(Col1) Where Col1 Is Not Null Group By Col1 Label Count(Col1) ''"; 0);2;FALSE)

.

 

[modoste]

ekli tablomda çok geniş bir alanda verilerim var.
Korhan Hocamın çözümünü benim çalışmama uyarladım ama hata aldım
hatam nerde ve dosyamın çözümünü yapabilir miyiz.

 

[Ömer]

Merhaba,

Gördüğüm kadarıyla;

=DOLAYLI(METNEÇEVİR(MİN(EĞER(($E$3:$EM$18<>"")*(EĞERSAY($B$2:B2;$E$3:$EM$18)=0);SATIR($E$3:$EM$18)*100+SÜTUN($E$3:$EM$18);7^8));"R0C00"); )&""

Son sütun indisi (EM sütunu) 143 dür. Bu değer 99 dan fazla olduğu için;

Formülde 100 ve R0C00 değerlerini 1000 ve R0C000 olarak değiştirmeniz gerekir.

Dinamik olması için aşağıdaki gibide yazılabilir.

=DOLAYLI(METNEÇEVİR(MİN(EĞER(($E$3:$EM$18<>"")*(EĞERSAY($B$2:B2;$E$3:$EM$18)=0);SATIR($E$3:$EM$18)*("1"&YİNELE("0";UZUNLUK(SÜTUN($EM$18))))+SÜTUN($E$3:$EM$18);7^8));"R0C"&YİNELE("0";UZUNLUK(SÜTUN($EM$18)))); )&""

Veri fazla olduğu için sonuçları kontrol etmedim. Formül mantığıyla hareket ettim. Yanlış mantık da kurmuş olabilirim. Detaylı denemekte fayda var.

 

[modoste]

formülleri kullandım sonuçlar net
çok teşekkür ederim

 

[modoste]

Hocam makro ile çözümü yapabilir miyiz. Yine dinamik olması durumu için

 

[Ömer]

Korhan Bey'in verdiği linkte makro ile çözüm vardı.

How to extract unique values from multiple columns in Excel?

www.extendoffice.com

.

 

[veyselemre]

Sub test()
    Application.ScreenUpdating = False
    Dim al$, r As Range, rng As Range, kys As Variant
    Set rng = Range("E8").CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For Each r In rng.SpecialCells(xlCellTypeConstants)
            al = r.Cells(1).Value
            If al <> "" Then .Item(al) = .Item(al) + 1
        Next r
        kys = Application.Transpose(Array(.keys, .items))
        Range("B3").Resize(UBound(kys), 2).Value = kys
    End With
    Application.ScreenUpdating = True
End Sub

 

[modoste]

makroyu şimdi denedim. 855 adet veriyi sıraladı
sıralamayı küçükten büyüğe yada büyükten küçüğe şeklinde Sıralama eklenebilir mi (elbet makro sonuç verince ayrı bir yerde sıralama denenebilir ama makro ile çözümünü istiyorum)

 

[veyselemre]

Sub test()
    Application.ScreenUpdating = False
    Dim al$, r As Range, rng As Range, kys As Variant
    Set rng = Range("E8").CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For Each r In rng.SpecialCells(xlCellTypeConstants)
            al = r.Cells(1).Value
            If al <> "" Then .Item(al) = .Item(al) + 1
        Next r
        kys = Application.Transpose(Array(.keys, .items))
        With Range("B3").Resize(UBound(kys), 2)
            .Value = kys
            .Sort [c3], xlDescending    'xlAscending
        End With
    End With
    Application.ScreenUpdating = True
End Sub

 

[modoste]

son makroyu denemedim ancak birşey soracam
kod içinde B3 ve E8 hücreleri geçiyo
bu hücreler nasıl tanımlanmış
B3 ilk verinin başlayacağı yani cevabın ilk nereye yazılacağı ama diğeri E8 i anlayamadım

 

[modoste]

en sol En üstteki veri E8 hücresinde görünüyo ama
EM3 hücresindede veri var. o bakımdan kod daki işlemi anlayamadım

 

[Korhan Ayhan]

Ne işlem yaptığını görmek için makroyu F8 tuşu ile adım adım çalıştırıp izleyebilirsiniz.

 

[modoste]

bu konu ile ilgili son bi sorum daha olacak sayın hocalarım
benim excelde karalerle çizdiğim şekiller aslında autocad de çizilmiş bir projenin sadeleşmiş hali gibi. autocad den bunu excelle yapabilme durumu varmıdır. autocaddeki şekillerin aynısı olmasıni istemiyorum elbet ama nasıl yapılabilir.

 

[modoste]

Sub test()
    Application.ScreenUpdating = False
    Dim al$, r As Range, rng As Range, kys As Variant
    Set rng = Range("E8").CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For Each r In rng.SpecialCells(xlCellTypeConstants)
            al = r.Cells(1).Value
            If al <> "" Then .Item(al) = .Item(al) + 1
        Next r
        kys = Application.Transpose(Array(.keys, .items))
        With Range("B3").Resize(UBound(kys), 2)
            .Value = kys
            .Sort [c3], xlDescending    'xlAscending
        End With
    End With
    Application.ScreenUpdating = True
End Sub

makroyu şimdi denedim teşekkür ederim