en çok olan değeri bulma

[Erdem Akdemir]

Merhaba,

Deneysel bir formül çalışmasında bir sütunda ençok olan metinsel ifadeyi bulmak için uğraşıyorum.

İstediğim sayı dizinini elde ettim ama RANK formülü dizileri çalıştırmıyor.Rank'ın dizileri çalıştırması için bir ek falan mı lazım.

Birde ={0\2\0\1\1\2} bir dizin elde ettiğimde dizinin sadece 1-4 aralığını yani 0\2\0\1 kısmını kullanmak isteseydim nasıl formüle etmem gerekirdi.

Makro yada ktf ile ilgilenmiyorum. Dediğim gibi sadece deneysel bir çalışma yapıyorum.Forumda bir tane alternatif formül buldum,ondan haberim var.

 

[Muhammet Okumuş]

Yardımcı sütun kullanın.

 

[Erdem Akdemir]

Bu iş makro ile'de zormuş. Metinsel değerleri tekrarlanma sıklıklarına göre nasıl sıralayabilirim.

Vba kodunu'da merak ettim. 3 gündür bunla uğraşıyorum, işi gücü bıraktım diyebilirim.

 

[bzace]

Sayın Kuvari,
Ali bey'in paylaştığı dosyayı elinde olan varsa paylaşılmasını istemişsiniz, elimde yok ama bildiğim formülleri daha sonra paylaşırım. (işim var)

Metinsel değerleri tekrarlanma sıklıklarına göre nasıl sıralayabilirim.

Tam istediğinizi yapmayacaktır, ama deneyiniz. B2 hücresine yazıp, aşağı doğru çoğaltınız.

=İNDİS($A$1:$A$30;KÜÇÜK(EĞER(KAÇINCI($A$1:$A$30;$A$1:$A$30;0)=SATIR()-1;
  KAÇINCI($A$1:$A$30;$A$1:$A$30;0);" ");SATIR()-1))&" İSMİ "&
    EĞERSAY($A$1:$A$30;İNDİS($A$1:$A$30;KÜÇÜK(EĞER(KAÇINCI($A$1:$A$30;$A$1:$A$30;0)=
      SATIR()-1;KAÇINCI($A$1:$A$30;$A$1:$A$30;0);" ");SATIR()-1)))&" KERE TEKRARLANDI"
[COLOR="Blue"]Formül dizi formüldür.CTRL + SHİFT + ENTER ile tamamlayınız.[/COLOR]

yada Arkadaş'ım şöyle bir kod gönderdi;
Bir şart koşarak istediğiniz yapılabilir belki.

Option Explicit

Sub AutoUniqCount(Target As Range)
  
  Const TopCellSrc = "A1"
  Const TopCellDest = "C1"
  
  Dim x, s$, Rng1 As Range, Rng2 As Range
  
  Set Rng1 = Range(TopCellSrc, Cells(Rows.Count, Left(TopCellSrc, 1)).End(xlUp))
  Set Rng2 = Range(TopCellDest, Cells(Rows.Count, Left(TopCellDest, 1)).End(xlUp))
  If Intersect(Target, Rng1.EntireColumn) Is Nothing And Intersect(Target, Rng2.Resize(, 2).EntireColumn) Is Nothing Then Exit Sub
  
  On Error GoTo exit_
  Application.EnableEvents = False
  
  Rng2.Resize(, 2).ClearContents
 
  With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For Each x In Rng1.Value
      If VarType(x) = vbString Then
        s = Trim(x)
        If Len(s) Then .Item(s) = .Item(s) + 1
      End If
    Next
    If .Count Then
      Range(TopCellDest).Resize(.Count, 2).Value = WorksheetFunction.Transpose(Array(.Keys, .Items))
    End If
  End With

exit_:
  Application.EnableEvents = True
  
End Sub

Private Sub Worksheet_Activate()
  AutoUniqCount Range(TopCellSrc)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  AutoUniqCount Target
End Sub

 

[Erdem Akdemir]

Sayın bzace ilginiz için teşekkür ederim, paylaşımlarınız benim istediğim değil. Ali bey'in formülü galiba aşağıdaki formül.Üçüncü satıra kopyalamak gerekiyor, ilk satırda gelmesini istenen değer sayısı, ikinci satırın ise boş olması gerekiyor.

=EĞER(SATIRSAY($C$3:C3)<=$C$1;İNDİS($A$2:$A$11;ENÇOK_OLAN(EĞER($A$2:$A$11<>"";EĞER(EYOKSA(KAÇINCI($A$2:$A$11;C$2:C2;0));KAÇINCI($A$2:$A$11;$A$2:$A$11;0)*{1;1}))));"")

 

[Korhan Ayhan]

Linkte çözümler var. İnceleyiniz.

Bir sütunda en çok olan isim

 

[bzace]

Korhan bey'in önerdiği linkte ve Ali bey'in dosyasında nasıl örnekler olduğunu göremediğimden ekli dosyayı inceleyiniz.(Alaaddin bey hariç)
Yöneticilerden rica etsem forum arşivinde bulunması açısından dosyayı mesaj olarak paylaşabilir mi ? (örnekler farklılık gösteriyorsa)
Dosyaya göre;
A1:A18 aralığına metinsel değerlerimizi girelim.
Birinci örnek için;

[B]B1[/B]:
=EĞERSAY(alan;A1)
[B]B2[/B]:
=EĞER(EĞERSAY(A$1:A1;A2)=0;EĞERSAY(A$2:A$18;A2)+1-(SATIR(A2)-SATIR(A$1))/SATIRSAY(alan)) 
[COLOR="red"]"B2 hücresine yazdığımız formülü gerektiği kadar aşağıya çekiniz."[/COLOR]

[B]E1[/B]:
=İNDİS(A1:A18;KAÇINCI(MAK(B1:B18);B1:B18;))
[B]E2[/B]:
=İNDİS(alan;KAÇINCI(BÜYÜK(B$1:B$18;SATIRSAY(E$1:E2));B$1:B$18;0))
[COLOR="Blue"]Forüller dizi formülüdür. CTRL + SHİFT + ENTER ile tamamlayınız.[/COLOR]
[COLOR="red"]"E2 hücresine yazdığımız formülü gerektiği kadar aşağıya çekiniz."[/COLOR]

İkinci örnek için;

[B]C1[/B]:
=İNDİS(alan;ENÇOK_OLAN(KAÇINCI(alan;alan;)))
[B]C2[/B]:
=ARA(2;1/(EĞERSAY(C$1:C1;alan)=0)/(EĞERSAY(alan;alan)=MAK(EĞER(EĞERSAY(C$1:C1;alan)=0;
  EĞERSAY(alan;alan))));alan)
[COLOR="Blue"]Forüller dizi formülüdür. CTRL + SHİFT + ENTER ile tamamlayınız.[/COLOR]
[COLOR="red"]"C2 hücresine yazdığımız formülü gerektiği kadar aşağıya çekiniz."[/COLOR]

Üçüncü örnek için;

[B]D1[/B]:
=İNDİS(alan;ENÇOK_OLAN(KAÇINCI(alan;alan;0)))
[B]D2[/B]:
=İNDİS(alan;ENÇOK_OLAN(EĞER(EĞERSAY(D$1:D1;alan)=0;KAÇINCI(alan;alan;0))))
[COLOR="Blue"]Forüller dizi formülüdür. CTRL + SHİFT + ENTER ile tamamlayınız.[/COLOR]
[COLOR="red"]"D2 hücresine yazdığımız formülü gerektiği kadar aşağıya çekiniz."[/COLOR]

Not: Üçüncü örnek aralıkta tek geçen isimleri listelemeyecektir.
Alan ifadesi Ad tanımlamasıdır.

İlgili Dosya : BURADAN

Daxe Syán

 

[Erdem Akdemir]

Sayın bzace örnekler için teşekkür ederim, elinize sağlık. Tek formülde yapmak zormuş.Sizin çözümleriniz de çok güzel.

 

[Merhum İdris SERDAR]

.

Buradaki dosyayı incelediniz mi?

http://www.excel.web.tr/f60/mode-mode-sngl-mode-mult-encok-olan-t109972.html


.

 

[Erdem Akdemir]

İdris bey sağolun, şu ana kadar sadece bir tane tek formülle ile çözüm buldum. Genelde yardımcı sütun kullanılarak yapılmış. O formülüde kırk yıl uğraşsam {1;1} ile yapamazdım.

Korhan bey'in önerdiği Ktf'li çözümler sadece ilk sonucu getiriyor, en fazla geçen değerler 2 farklı değer aralıkta en son geçeni getiriyor.

Makrolu çözüm kimseden gelmedi. Makro ile olur diye düşündüm ama oda zormuş.

 

[Korhan Ayhan]

Makro ile alternatif çözüm;

Kullanılan fonksiyon;

Option Explicit

Function ENÇOKOLAN(Alan As Range, Çokluk_Sırası As Long)
    Dim Hücre As Range
    Dim Dizi As Object
    Dim WF As WorksheetFunction
    Dim Say As Long
    Dim X As Long
    Dim Y As Long
    Dim VeriA As Variant
    Dim VeriB As Variant
    
    Application.Volatile True
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    Set WF = WorksheetFunction
    
    ReDim Liste(1 To 2, 1 To 1)
    
    For Each Hücre In Alan
        If Hücre.Value <> "" Then
            If Hücre.Height <> 0 Then
                If Not Dizi.Exists(Hücre.Value) Then
                    Say = Say + 1
                    Dizi.Add Hücre.Value, 1
                    ReDim Preserve Liste(1 To 2, 1 To Say)
                    Liste(1, Say) = Hücre.Value
                    Liste(2, Say) = WF.CountIf(Alan, Hücre.Value)
                End If
            End If
        End If
    Next
    
    For X = LBound(Liste, 2) To UBound(Liste, 2)
        For Y = X + 1 To UBound(Liste, 2)
            If Liste(2, X) < Liste(2, Y) Then
                VeriA = Liste(1, Y)
                VeriB = Liste(2, Y)
                Liste(1, Y) = Liste(1, X)
                Liste(2, Y) = Liste(2, X)
                Liste(1, X) = VeriA
                Liste(2, X) = VeriB
            End If
        Next
    Next
    
    ENÇOKOLAN = Liste(1, Çokluk_Sırası)
End Function

 

[Murat OSMA]

Alternatif olarak ENÇOK_OLAN fonksiyonu ve Özet Tablo ile de yapabilirsiniz.

 

[Erdem Akdemir]

Makro ile alternatif çözüm;

Kullanılan fonksiyon;

Option Explicit

Function ENÇOKOLAN(Alan As Range, Çokluk_Sırası As Long)
    Dim Hücre As Range
    Dim Dizi As Object
    Dim WF As WorksheetFunction
    Dim Say As Long
    Dim X As Long
    Dim Y As Long
    Dim VeriA As Variant
    Dim VeriB As Variant
    
    Application.Volatile True
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    Set WF = WorksheetFunction
    
    ReDim Liste(1 To 2, 1 To 1)
    
    For Each Hücre In Alan
        If Hücre.Value <> "" Then
            If Hücre.Height <> 0 Then
                If Not Dizi.Exists(Hücre.Value) Then
                    Say = Say + 1
                    Dizi.Add Hücre.Value, 1
                    ReDim Preserve Liste(1 To 2, 1 To Say)
                    Liste(1, Say) = Hücre.Value
                    Liste(2, Say) = WF.CountIf(Alan, Hücre.Value)
                End If
            End If
        End If
    Next
    
    For X = LBound(Liste, 2) To UBound(Liste, 2)
        For Y = X + 1 To UBound(Liste, 2)
            If Liste(2, X) < Liste(2, Y) Then
                VeriA = Liste(1, Y)
                VeriB = Liste(2, Y)
                Liste(1, Y) = Liste(1, X)
                Liste(2, Y) = Liste(2, X)
                Liste(1, X) = VeriA
                Liste(2, X) = VeriB
            End If
        Next
    Next
    
    ENÇOKOLAN = Liste(1, Çokluk_Sırası)
End Function

Korhan bey mükemmel bir çözüm, elinize sağlık.

 

[Erdem Akdemir]

Korhan bey kodun bu kısmını biraz açıklayabilir misiniz.

[COLOR="Red"]If Hücre.Height <> 0 Then
                If Not Dizi.Exists(Hücre.Value) Then
                    Say = Say + 1
                    Dizi.Add Hücre.Value, 1[/COLOR]

 

[Korhan Ayhan]

Eğer Hücre yükseklik değeri sıfıra eşit değilse... (Bu bölüm sayfada filtre uygulanmış hücreleri atlamak için kullanıldı)
Eğer Hücre değeri Dizi listesinde yoksa...
Say değerini bir arttır...
Dizi listesine Hücre değerini ekle...

Bu şekilde benzersiz veri listesi oluşturuluyor.

 

[Erdem Akdemir]

Eğer Hücre yükseklik değeri sıfıra eşit değilse... (Bu bölüm sayfada filtre uygulanmış hücreleri atlamak için kullanıldı)
Eğer Hücre değeri Dizi listesinde yoksa...
Say değerini bir arttır...
Dizi listesine Hücre değerini ekle...

Bu şekilde benzersiz veri listesi oluşturuluyor.

Korhan bey çok sağolun, sizde olmasanız.

 

[Korhan Ayhan]

Fonksiyondaki hücre aralığını "A2:A100000" yapmak istediğimde formül hatası oluşuyor. Buna anlam veremedim.

Çünkü aralığı "A:A" olarak düzelttiğimde formül çalışıyor.

Sebebi hakkında bilgisi olan üyemiz var mı?

 

[Erdem Akdemir]

Korhan bey 2013 excel'de bende hata vermedi.

Belki 2003 excel'de denemiş olabilir misiniz.

 

[Korhan Ayhan]

Hayır bende excel 2013 versiyonda denedim.

Aralığı genişletince formül yazma hatası veriyor.

 

[Korhan Ayhan]

Hatamı buldum. Dosya 2003 formatında kayıt edildiği için hata alıyormuşum.

Dikkatsizlik işte...

Sanırım yaşlanıyorum...