vba da koşullu sayma

[heft]

Merhaba,
k sayfasındaki koşullu toplamı aşağıdaki gibi alıyorum sorun yok.
Ancak çok yavaşlatıyor acaba bunu vba da nasıl bir kod ile yazmalıyım?
=TOPLA.ÇARPIM((k!A2:A5994<>"")/EĞERSAY(k!A2:A5994;k!A2:A5994&""))

 

[Korhan Ayhan]

Selamlar,

Sorunuzu örnek dosya ile desteklermisiniz.

 

[heft]

dosya ekledim

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kod ile sütundaki benzersiz kayıtların sayısını bulabilirsiniz. TOPLA.ÇARPIM fonksiyonunu VBA da kullanmak size hız kazandırmaz.

Sub BENZERSİZ_SAY()
    Dim DİZİ As New Collection, VERİ As Range
 
    On Error Resume Next
    For Each VERİ In Range("A2:A" & Range("A65536").End(3).Row)
        DİZİ.Add VERİ, CStr(VERİ)
    Next
    On Error GoTo 0
 
    MsgBox DİZİ.Count
End Sub

 

[heft]

çok teşekkürler

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki koduda kullanabilirsiniz. Her ikiside hızlı sonuçlar vermektedir.

Option Explicit
 
Sub BENZERSİZ_SAY()
    Dim SD As Object, VERİ As Range
    Set SD = CreateObject("Scripting.Dictionary")
 
    For Each VERİ In Range("A2:A" & Range("A65536").End(3).Row)
    If VERİ.Value <> "" Then
        If Not SD.Exists(VERİ.Value) Then
            SD.Add (VERİ.Value), 1
        End If
    End If
    Next
 
    MsgBox SD.Count
End Sub