Benzersizleri Sayma

[acar6783]

Bu konu başlığı altında çok soru ve cevap var ama iki seçenek var;
Formül olarak

=TOPLA.ÇARPIM((G4:G65536<>"")/EĞERSAY(G4:G65536;G4:G65536&""))

Var fakat bu formül sistemi çok yoruyor.

Alternatif olarak,

sat = Cells(Rows.Count, "G").End(xlUp).Row
For i = 1 To sat
    If WorksheetFunction.CountIf(Range("G1:G" & i), Cells(i, "G").Value) = 1 Then say = say + 1
[F1]=say
Next

var fakat bu da aynı şekilde veri çok olunca döngüden dolayı yavaş çalışıyor.


Alternatif bir kod ya da formül varmıdır?

 

[Emir Hüseyin Çoban]

http://www.excel.web.tr/f48/yinelenen-hucre-kodu-yardym-t152948.html

.

 

[acar6783]

Evet müthiş hızlı Teşekkürler ...
Bu kodları hızlı yapan olay nedir ?

Bı kodları açıklayabilirmisiniz size zahmet sanırım dosyamda buna benzer kodlara ihtiyaç duyacağım

Sub KOD()
    Dim SD As Worksheet: Set SD = Sheets("Sayfa1")
    Dim liste()
    
    son = SD.Cells(Rows.Count, "A").End(3).Row
    liste = SD.Range("A1:A" & son).Value
    
    Set dic = CreateObject("scripting.dictionary")
    For x = 1 To UBound(liste, 1)
        aranan = liste(x, 1)
        If Not dic.exists(aranan) Then
            dic.Add aranan, ""
        End If

    Next x
       
    Cells(son + 1, "A") = dic.Count
End Sub

 

[bzace]

Merhabalar,
scripting.dictionary farklı bir alternatif olsun.

Sub Benzersiz_Say()
Dim Ar, Arr, i
On Error Resume Next
Set i = CreateObject("Scripting.Dictionary")
Arr = [A1:A65536]
For Each j In Arr
    i.Add CStr(j), j
Next
Ar = i.items
[B1] = UBound(Ar)
End Sub

Saygılar,
Hay marja!

 

[acar6783]

Diğer kodları az cok anlayabiliyorum da;

CreateObject("Scripting.Dictionary")

Ne yapıyor da bu işlem hızlı oluyor?

Bu kodu Değer aramada da kullanabilirim muhetemelen?
Yani
10000 satırlık bir sütundaki aradığım değerin satır nuarasını verecek bir kod uyarlayabilirim.

 

[acar6783]

Kolay gelsin arkadaşlar,
Benzer konuda bir cevaba daha ihtiyacım var.
Konuyu hala idrak edemediğim için mecburen yeniden soru soruyorum

29122015233546F.1
30122015233546F.1
30122015233546F.1
30122015233546F.1

Değerlerinde soldan 2 rakamı kontrol edip bugüne(30) eşit mi değil mi bakıp.Sonrasında ise
"."dan sonra kaç farklı değer olduğunu nasıl saydırabilirim?

 

[alicimri]

Sayın acar6783
Sayın bzace nin kodlarını sorunuza uyarlamaya çalıştım.

Sub Benzersiz_Say()
Dim Ar, Arr, i
On Error Resume Next
Set i = CreateObject("Scripting.Dictionary")
Arr = [A1:A65536]
For Each j In Arr
If Left(j, 2) * 1 = Day(Date) * 1 Then
a = Split(j, ".")(1)
 i.Add CStr(a), a
End If
Next
Ar = i.items
MsgBox UBound(Ar) + 1
End Sub

 

[acar6783]

Teşekkürler istediğim oldu.
Fakat
Ben aslında balıktan cok balık tutmayı istiyorum ama Enteresandır ki hiç cevap alamıyorum

Bu kodlarda bir anlamadığım

 i.Add CStr(a), a

Burası var ve sanırım cevabı da burası buluyor.