Sütundaki aynı değere sahip hücre sayısı

[Muratizmir]

Merhaba;
Elimde 18 bin satırlık bir liste var ve bu listede birçok aynı değere sahip hücre var.
Koşullu biçimlendirme işimi görmüyor zira bana aynı değere sahip hücrelerin sayısı lazım.
Özet tablo ilede yaptım ancak amacıma ulaşamadım.
İsteğim A sütunundaki hücre içeriği aynı olanların sayısının B hücresine yazılması.
Örnek tabloda kısaca göstermeye çalıştım.
Şimdiden teşekkür ederim.

http://s4.dosya.tc/server3/4pddps/ornek.xlsx.html

 

[Korhan Ayhan]

B2 hücresine uygulayınız. Alt hücrelere sürükleyiniz.

=EĞERSAY(A:A;A2)

 

[Muratizmir]

İlginize çok teşekkür ederim.

 

[Muratizmir]

B2 hücresine uygulayınız. Alt hücrelere sürükleyiniz.

=EĞERSAY(A:A;A2)

Tekrar merhaba, bu formülün makrosu ile aynı işlemi yapmak istesem makrosu nasıl olurdu acaba?
Şuanda aynı formülü 352 bin satırlık bir veride yapıyorum ama bir türlü bitmek bilmiyor hesaplama. Acaba makroda aynı süredemi hesaplar yoksa daha kısamı olur diye düşündüm.

 

[Korhan Ayhan]

Veriniz çoksa formül yerine hızlı ve kolay bir şekilde ÖZET TABLO kullanarak veri tekrar sayılarını elde edebilirsiniz.

 

[Muratizmir]

Evet bunu deneyeceğim teşekkür ederim.

 

[Korhan Ayhan]

Ek olarak aşağıdaki makroyu deneyebilirsiniz.

Option Explicit

Sub Count_Repetitions()
    Dim Data As Variant, X As Long, Process_Time As Double
    
    Process_Time = Timer
    
    Data = Range("A2:A" & WorksheetFunction.Max(Cells(Rows.Count, 1).End(3).Row, 3)).Value

    ReDim My_List(1 To UBound(Data, 1), 1 To 1)

    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Data, 1) To UBound(Data, 1)
            .Item(Data(X, 1)) = .Item(Data(X, 1)) + 1
        Next
    
        For X = LBound(Data, 1) To UBound(Data, 1)
            My_List(X, 1) = .Item(Data(X, 1))
        Next
    End With
    
    Range("B2:B" & Rows.Count).ClearContents
    Range("B2").Resize(UBound(Data, 1)) = My_List
    
    MsgBox "Your transaction is complete." & vbCr & vbCr & _
           "Processing time ; " & Format(Timer - Process_Time, "0.00") & " Second"
End Sub

 

[Muratizmir]

Ek olarak aşağıdaki makroyu deneyebilirsiniz.

Option Explicit

Sub Count_Repetitions()
    Dim Data As Variant, X As Long, Process_Time As Double
   
    Process_Time = Timer
   
    Data = Range("A2:A" & WorksheetFunction.Max(Cells(Rows.Count, 1).End(3).Row, 3)).Value

    ReDim My_List(1 To UBound(Data, 1), 1 To 1)

    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Data, 1) To UBound(Data, 1)
            .Item(Data(X, 1)) = .Item(Data(X, 1)) + 1
        Next
   
        For X = LBound(Data, 1) To UBound(Data, 1)
            My_List(X, 1) = .Item(Data(X, 1))
        Next
    End With
   
    Range("B2:B" & Rows.Count).ClearContents
    Range("B2").Resize(UBound(Data, 1)) = My_List
   
    MsgBox "Your transaction is complete." & vbCr & vbCr & _
           "Processing time ; " & Format(Timer - Process_Time, "0.00") & " Second"
End Sub

Çok teşekkür ederim. 310 bin veri 26 saniye.
Elinize emeğinize sağlık.