• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

en çok olan değeri bulma

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,677
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
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.
 

Ekli dosyalar

Son düzenleme:
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.
 
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.
Kod:
=İ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.
Kod:
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
 
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.

Kod:
=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 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;
Kod:
[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]
Kod:
[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;
Kod:
[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;
Kod:
[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
 
Son düzenleme:
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.
 
İ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ş.
 
Makro ile alternatif çözüm;

Kullanılan fonksiyon;

Kod:
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
 

Ekli dosyalar

Alternatif olarak ENÇOK_OLAN fonksiyonu ve Özet Tablo ile de yapabilirsiniz.
 
Makro ile alternatif çözüm;

Kullanılan fonksiyon;

Kod:
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.
 
Korhan bey kodun bu kısmını biraz açıklayabilir misiniz.

Kod:
[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]
 
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.
 
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.
 
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ı?
 
Korhan bey 2013 excel'de bende hata vermedi.

Belki 2003 excel'de denemiş olabilir misiniz.
 
Hayır bende excel 2013 versiyonda denedim.

Aralığı genişletince formül yazma hatası veriyor.
 
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...
 
Geri
Üst