..::.. En çok Tekrarlanan İLK 9 Değeri Listeleme ..::..

[Ömer BARAN]

..::.. En çok Tekrarlanan Belli Sayıda Değeri Listeleme ..::..

Merhabalar!
Makro kod konusunda desteğe ihtiyacım oldu.

Örnek belgede de açıkladım.
Sütunlarda en çok tekrarlanan belli sayıda değerin (en çok tekrarlanan en üstte olacak şekilde tekrarlanma sıklığına göre) başka sayfaya listelenmesine ihtiyacım var.
Belli sayı diye ifade ettiğim sayı hücreden alınabiliyorsa N4 hücresindeki sayı kadar değerin listelenmesi lazım
Makro kodun, sayfadaki veri doğrulama uygulanmış hücrede "LİSTELE" seçildiğinde veya bir düğme vasıtasıyla ya da N4 hücresinin seçilmesiyle tetiklenmesini sağlamak gerek.

İlgileneceklere şimdiden teşekkürler.

 

[Ömer BARAN]

Açıklama

Merhabalar !...
İsteğimi karşıladığını düşündüğüm ancak Ms.Excel'in yerleşik fonksiyonlarını kullanan kod mevcut. (Kodlar Sayın Muhammet Okumuş tarafından yazılmıştır)
Excel'in yerleşik fonksiyonlarını kullanmadan çözüm bulmam lazım. Çünkü asıl belgemdeki diğer sayfalarda çok sayıda DİZİ formülü mevcut olduğundan otomatik hesaplamayı devre dışı bırakmak istiyorum, böyle yapmazsam yerleşik fonksiyonları kullanan makro kod çalıştığında belge çoğu kez donuyor, excel cevap vermiyor hale geliyor.

 

[Ömer BARAN]

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

Merhabalar Sayın Ayhan, kod bilgim olmayınca içinden çıkamadım, mevcut kodu (süzme işlemini yok sayarak) konu açılış mesajımdaki belgeme uyarlayamadım (sütun yapıları farklı, birden fazla sütunun birlikte değerlendirilmesi, sıklık sırasına göre oluşacak listenin başka sayfaya alınması gibi sıkıntılarım var) , sizin için sıkıntı olmayacaksa bakabilirseniz sevinirim.
Ayrıca her sütun için farklı sayıda veri ayıklamam da zorunlu değil, ilgili sütunlar için örneğin ilk 20'yi sıralamam fazlasıyla yeterli olacaktır.
Teşekkürler.

 

[Ömer BARAN]

Konu günceldir, çözüm bulunmamıştır, bilgi sahibi üyelerin ilgi göstermesi ricasıyla.

Tekrar merhabalar, konu açılış mesajını yeniden düzenledim ve açılış mesajı ekindeki örnek dosyayı güncelledim.

Kod bilgim olmadığı için; benzer bir konu ile ilgili olarak Sayın Korhan Ayhan tarafından yazılmış, bu konudaki 3 no'lu mesajda yer alan makro kodu dosyama uyarlayamadım.

Örnek dosyamda elle çözüme ilişkin örnekler de ekledim.

Yukarıdaki kodu dosyama uyarlama konusunda, kod bilgisi olan üyelerin desteğini rica ediyorum.

Konu günceldir, çözüm bulunmamıştır.

 

[Zeki Gürsoy]

Sorunuz iyi anlaşılmıyor.

 

[Ömer BARAN]

Sorunuz iyi anlaşılmıyor.

Sayın Gürsoy, bu konudaki 3 no'lu mesajımda; Sayın AYHAN tarafından başka bir konu (en çok olan) sayfasındaki 11 no'lu mesajda yer alan ENÇOKOLAN ktf'nin benim dosyama uyarlanması ricasında bulunmuştum.
Konu açma sebebim tam olarak şöyle; belgemdeki (sayfa : HAM) birkaç sütunda (tümü metinsel) en çok tekrarlanan 20 verinin tekrarlanma sıklığına göre başka bir sayfaya (TEKRARLANAN) listelenmesi.
Orijinal belgemde çok sayıda DİZİ formülü mevcut olduğundan ve veri yığınımın binlerce satır, 100 küsur sütunlu olması nedeniyle, bu işlemin yardımcı sütunlar ve buralara uygulanacak formüller veya yeni DİZİ formülleri ya da excelin yerleşik fonksiyonlarını sayfalara uygulayarak çalışan makro kodlarla yapılması, belgemin çok yavaşlamasına hatta donmalara neden oluyor.
Bu yüzden ktf (Sayın AYHAN'ın yazdığı gibi) veya otomatik hesaplama devre dışı iken de çalışacak kodlarla çözülmesi lazım.
Belgemdeki TEKRARLANAN sayfasında her sütun için ayrı ayrı elle yazdığım birkaç örnek sonuç mevcut.
İlginiz için teşekkürler, destek vereceğiniz umuduyla, iyi günler dilerim.

 

[turist]

Formüller ve küçük bir kod yardımı ile çözümlü dosyanız eklidir.
İnceleyiniz.

 

[Ömer BARAN]

Formüller ve küçük bir kod yardımı ile çözümlü dosyanız eklidir.
İnceleyiniz.

Sayın turist herzamanki gibi yine çok emek harcamışsınız, teşekkür ederim.
Ancak, konunun başından beri vurguladığım gibi, belgemin orijinalinde çok sayıda dizi formülü var ve veri yığınım çok fazla.
O nedenle formüllerle çözüm yerine otomatik hesaplama devre dışı iken de çalışacak makro veya ktf ile çözüm bulmam gerekiyor.
Zahmetler verdim, emeğinize sağlık.
Sizin yaptığınıza benzer şekilde; yardımcı sütunlar, bir sürü formül gibi yöntemlerle sonuca zaten ulaşabiliyorum.
Söylediğim gibi ihtiyacım formüllerle çözüm değil tamamen makro veya ktf ile çözüm. Keşke konudaki 3 no'lu mesajın alıntı bölümünde yer alan ve Sayın Korhan AYHAN'ın başka bir konu için hazırladığı koda müdahale edebilseniz ve onu kullansam.

 

[Korhan Ayhan]

Ekteki dosyayı inceleyiniz.

 

[Ömer BARAN]

Teşekkürler.

Ekteki dosyayı inceleyiniz.

Merhabalar Sayın AYHAN.
Destek için teşekkürler ederim, sağ olunuz var olunuz.

Eki bir kez açıp çalıştırdım, sizin yazdığınız kodda sorun çıkması pek olası değil ama belki benden kaynaklı sorun olabilir diye gerçek verilerimle yarın test edip tekrar dönüş yaparım.
Sağlıcakla.

 

[Zeki Gürsoy]

Bir tane de benden. Çok hızlı çalışan bir algoritma. İnceleyin.

Sub Baran_Listele()
    Dim rs As Object, son As Long, arr(1 To 5) As Variant, b As Integer, c As Long
    
    Sayfa2.Range("B2:F21").ClearComments
    Sayfa2.Range("B2:F21").ClearContents
    
    son = Sayfa1.[I100000].End(3).Row
    
    [COLOR=DarkGreen]'İyi performans için belleğe al[/COLOR]
    arr(1) = Sayfa1.Range("I8:I" & son).Value2
    arr(2) = Sayfa1.Range("M8:M" & son).Value2
    arr(3) = Sayfa1.Range("N8:N" & son).Value2
    arr(4) = Sayfa1.Range("Q8:Q" & son).Value2
    arr(5) = Sayfa1.Range("EA8:EA" & son).Value2

    For b = 1 To 5
        
        Set rs = CreateObject("ADODB.Recordset")
        
        rs.Fields.Append "Ad", 200, 255[COLOR=DarkGreen] 'varchar(255)[/COLOR]
        rs.Fields.Append "Sıklık", 20[COLOR=DarkGreen] '64 bit long[/COLOR]

        rs.Open , , 0, 3[COLOR=DarkGreen] 'forward,optimistic
[/COLOR]
        For c = 1 To UBound(arr(b), 1)
        
            If Trim(arr(b)(c, 1)) <> "" Then[COLOR=DarkGreen] 'Aralarda boş hücreler var[/COLOR]
            
                rs.Filter = "Ad = '" & arr(b)(c, 1) & "'"
    
                If rs.RecordCount = 0 Then
                    rs.AddNew Array("Ad", "Sıklık"), Array(arr(b)(c, 1), 1)
                Else
                    rs.Fields("Sıklık") = rs.Fields("Sıklık") + 1
                End If
                
            End If
            
        Next
        
        rs.Filter = 0[COLOR=DarkGreen] 'Filitre deaktif[/COLOR]
        
        rs.Sort = "[Sıklık] Desc" [COLOR=DarkGreen]'Azalan sıralama[/COLOR]

        rs.MoveFirst[COLOR=DarkGreen] 'İlk kayda git[/COLOR]
        
        For c = 1 To 20 'İlk 20
            Sayfa2.Cells(c + 1, b + 1) = rs.Fields("Ad")
            Sayfa2.Cells(c + 1, b + 1).AddComment _
                "::..www.excel.web.tr..::" & vbCr & String(30, "-") & _
                vbCr & rs.Fields("Sıklık") & " tekrarlama"
            rs.MoveNext
            If rs.EOF Then Exit For [COLOR=DarkGreen]'20 kayıt yoksa döngüden çık[/COLOR]
        Next
        
    Next
    
End Sub

 

[Ömer BARAN]

Bir tane de benden. Çok hızlı çalışan bir algoritma. İnceleyin.

Sub Baran_Listele()
    
End Sub

Sayın GÜRSOY ne diyeyim bilemedim. Harika olmuş, diğer kodla hız karşılaştırmasına gerek bile yok, 3 saniyede işlem tamam.

Gıpta ile bakmaktayım, böyle çözümler öğrenme isteğimi artırıyor.
Komutlar, aynı işlemi görenlerin birbirlerine göre farkları gibi konularda yararlanılabilecek bir kaynak söyleyebilir misiniz acaba?
Elbette kalıcı olan okuyarak değil, yaparak öğrenmek. Ancak yine de kaynak söylrseniz sevinirim. İş yoğunluğu arasında fırsat buldukça bakmak isterim.

ÇOK, ÇOK TEŞEKKÜRLER.

 

[Ömer BARAN]

Sayın GÜRSOY koddaki

For c = 1 To 20 'İlk 20

bölümünde yer alan 20 değerini hücreden (Örneğin HAM -kodda Sayfa1- adlı sayfa I6 hücresi) almak istersem, nasıl değiştireyim acaba?
Sheets("HAM").I6.Value gibi bir kaç şey denedim, olmadı.

 

[Ömer BARAN]

Kendi bilgisayarım açılışta otomatik restart döngüsüne girdiğinden kullanılabilir değil, buraya yüklediğim örnek dosyalarım üzerinde çalışıyorum. Orijinal belgemde de sorun çıkacağını sanmıyorum ama hayırlısı bakalım.

 

[Zeki Gürsoy]

"HAM" sayfasında "20" yi N4 hücresinde tanımlamışsınız.

for c=1 to sheets("ham").[n4]

yeterli olacaktır.

VBA konusunda yeni şeyler öğrendikçe en iyi çalışacak kodu zaten kendiliğinden üretirsiniz.

Kolay gelsin.

 

[Ömer BARAN]

Eyvallah sağ olunuz, var olunuz.
Konuyu şimdilik kapatıyorum, orijinal belgeme ulaşabildiğimde sorun yaşarsam tekrar açarım.
Sağlıcakla.

KONU ÇÖZÜLMÜŞTÜR.

NOT: Çözümde soruna rastladığım için konuyu yeniden açtım.

 

[Ömer BARAN]

Bir tane de benden. Çok hızlı çalışan bir algoritma. İnceleyin.

Sub Baran_Listele()
................................
[B][COLOR="red"](1)[/COLOR][/B]    arr(5) = Sayfa1.Range("[B][COLOR="Red"]EA8:EA[/COLOR][/B]" & son).Value2
[B][COLOR="red"](2)[/COLOR][/B]    For b = 1 To [COLOR="red"][B]5[/B][/COLOR]
...........................
[B][COLOR="red"](3)[/COLOR][/B]        rs.Fields.Append [B][COLOR="red"]"Ad", 200, 255[/COLOR][/B][COLOR=DarkGreen] 'varchar(255)[/COLOR]
...........................            
[B][COLOR="red"](4)[/COLOR][/B]        rs.Filter = [B][COLOR="red"]"Ad = '" & arr(b)(c, 1)[/COLOR][/B] & "'"
..........................
[B][COLOR="red"](5)[/COLOR][/B]                vbCr & rs.Fields("Sıklık") & " tekrarlama"
...........................    
End Sub

Merhaba Sayın GÜRSOY, kod ile ilgili bir sorun mevcut, birkaç tane de sorum var.
..::.. SORUN: ..::..
Kodda, başına (1) yazdığım satırdaki alan adı EA-EA iken de EA-EZ olarak değiştirdiğimde de, tanı sıklığını yanlış sayıyor daha doğrusu sadece EA sütunundaki sıklığı sayıyor ve dolayısıyla buna göre sıralayıp, hücre açıklamalarını da buna göre yazıyor.
..::.. BİRKAÇ TANE DE SORUM VAR: ..::..
-- Kodda, başına (2) yazdığım satırdaki 5 sayısı sanırım oluşturulan dizi adedi, doğru mudur?
-- Kodda, başına (3) yazdığım satırdaki "Ad" ibaresi ile 200 ve 255 sayılarının anlamını merak ettim ve aynı ibare, başına (4) yazdığım satırda da var, bunların anlamı nedir acaba?

İlgi ve destek için çok teşekkürler ederim.
Konuyu kapatmıştım ama sorunu fark edince yeniden açtım.

 

[Zeki Gürsoy]

Tekrar merhaba,

Sırayla cevaplayayım.

(1) --> Benim "anlaşılmıyor" dediğim yer burasıydı aslında. EA-EA arasında 1000 hücre varsayımında, EA-EZ aralığında 29000 hücre belleğe alınıyor. Belleğe alma hızlıdır, yavaşlama dögü içindedir muhtemelen. Belleğe alırken iki boyutlu bir diziye dönüşür ve birinci sütunu kullan dedim. EA-EZ aralığında gruplama nasıl olacak? Burayı açıklayın. Toplam işlem süresi ne kadar uzadı? Bunu da merak ettim.

(2) --> Evet 5 elemanlı bir dizidir. 5 farklı değişen kullanabilirdim. Ancak bu defa for döngüsünü 5 defa yazmam gerekirdi ki, bu da daha uzun bir prosedur anlamına gelir. Bu tamamen kısa bir kod yazma amacına dönük bir durum.

(3) --> 200 string tipi sütun ve azami 255 karakter (harf) alabilir demektir. İhtiyaca göre artırılabilir.

(4) --> Sıkılığı hesaplarken kullandım. Eleman listeye daha önce alınmadıysa listeye al ve frekansı (sıklık) "1" ata; listeye alındıysa frekansı "1" artır.

(5) --> Hücre açıklamasına frekansı yazdırdık.

 

[Ömer BARAN]

Sayın GÜRSOY, sadece EA-EZ aralığındaki 26 sütunun hepsinin birlikte dolu olma ihtimali yok zaten, şu andaki orijinal belgemde (yaklaşık 5 aylık veridir) dahi en fazla 11 sütunda veri var ve bunların adet toplamı da 2500 olup, bunların sütunlara dağılımı ise EA'dan başlayarak sırasıyla 2031, 349, 94, 18, 8, 6, 4, 4, 4, 4 ve 1 şeklinde.
Zaten bir satırda EB boşsa EC ve devamı boş, EC boşsa ED ve devamı boş olur, yani bir satırdaki veriler boşluksuz olarak EA-EZ aralığına dağılıyor. Veri yığını yaklaşık 2400 satır iken EA-EZ aralığındaki veri adeti 2523. Bu durum zannımca her zaman gerçekleşecek olan istatistiki durum olacaktır.

Aklıma gelen yöntem ise şöyle, EA'dan başlayarak EZ'ye kadarki sütunları sırasıyla yeni bir sayfada TEK bir sütuna alıp, boşlukları sildikten sonra mevcut kodun burada çalışmasını sağlasak ve iş bitiminde de bu sayfayı silsek diyorum. Neticede Screen updating false olduğundan göz de fark etmeyecek.
Bu yöntemi söylüyorum ama mümkünlüğü knusunda pek fikrim yok aslında.

Merak ettiğim hususlarla ilgili açıklamalarınız için de sağ olunuz.

 

[Ömer BARAN]

Bu haliyle excelin otomatik hesaplamasını pasif hale getirip çalıştırdığımda kod 3-4 saniyede işlemi tamamlıyor. Kaldı ki bu bilgisayar emanet ve işlemcisi filan zayıf bir bilgisayar. Bu süre gerek fonksiyon ve gerekse de konuya yazılan diğer kodların süreleriyle kıyaslanmaz bile. Keşke kod, TEKRARLANMA sayfasında K1 ve L1 hücrelerine çalışmaya başladığı zamanı ve bitirdiği zamanı yazsa çok güzel olurdu.
Düzeltme: Saat işini hallettim.