Sütundaki Benzersiz Değerleri ve Kaçar Adet Olduklarını Formülle Bulma

[Salih Hoca]

Merhaba.

Eklediğim örnek dosyadaki F6:F45 aralığındaki benzersiz değerlerin neler olduğunu ve kaçar tane olduklarını bulmak istiyorum. Yani kırmızı renkli alanı formül ya da fonksiyonla nasıl otomatik olarak oluşturabilirim?

İki gündür arıyorum, birçok örnek buldum ama tam istediğim şeyi bulamadım malesef. Yardımınız için şimdiden teşekkürler.

 

[bzace]

Hayırlı akşamlar,
Benzersiz verileri almak için Gelişmiş Filtreleme adetleri bulmak için ise EĞERSAY fonksiyonunu kullanabilirsiniz.

 

[turist]

Dosyanız ektedir.

 

[Salih Hoca]

bzace ve turist ikinize de çok teşekkürler.
Gelişmiş Filtreleme tam olarak işimi görmüyor. Bir çalışma kitabında 60 tane benzeri sayfa var ve her birine tek tek gelişmiş filtre uygulamak ya da veriler değişince tekrarlamak çok zor. Şablon bir sayfa oluşturup onu 60 sayfaya uyarlamak daha kolay geldi. Makrolarla aram iyi olsa makro çalıştırıp 60 sayfaya uyarlamak en kolayı olsa gerek.

Şimdi şöyle bir sorun oluştu. Benzersiz değer sayısıyla formüllü hücre sayısı eşit değilse #YOK ve 0 hatası görünüyor. Boş hücrelerde de formül olsun istiyorum, bazı sayfalarda 8 tane benzersiz değer bazı sayfalarda da 3 tane benzersiz değer olabilir veya duruma göre değişebilir. benzersiz değer sayısı az olsa da hata göstermesini engelleyebilir miyiz?
Dosyayı yeniden yükledim.

 

[Orion1]

Bende kod ile yaptım.
Dosyanız ektedir.

Option Base 1
Sub toplamlar59()
Dim i As Long, liste(), sat As Long, z As Object
Range("I6:J" & Rows.Count).Clear
sat = Cells(Rows.Count, "F").End(xlUp).Row
liste = Range("F6:F" & sat).Value
Set z = CreateObject("scripting.dictionary")
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        z.Add liste(i, 1), 1
    Else
        z.Item(liste(i, 1)) = z.Item(liste(i, 1)) + 1
    End If
Next i
Erase liste
Application.ScreenUpdating = False
Range("I6").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Application.ScreenUpdating = True
Set z = Nothing
MsgBox "Benzersizlerin toplamı çıkarıldı" & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[Salih Hoca]

#YOK ve 0 sorunlarını araştırmalar ve uyarlamalar sonucunda çözmeyi başardım.


Orion1 hocam size de çok teşekkürler. Çok faydalı bir kod paylaştınız. Bana da bu kodu aynı anda 60 sayfa için çalışacak şekilde uyarlayabilmeyi başarmak kaldı

 

[Orion1]

#YOK ve 0 sorunlarını araştırmalar ve uyarlamalar sonucunda çözmeyi başardım.


Orion1 hocam size de çok teşekkürler. Çok faydalı bir kod paylaştınız. Bana da bu kodu aynı anda 60 sayfa için çalışacak şekilde uyarlayabilmeyi başarmak kaldı

Kolay gelsin.