tablodaki tekrarlar sayılacak ve başka bir tabloya adetleri yazılacak

[seyficetin]

arkadaşlar,

bir tabloda tekrarlanan veriler adet olarak sayılacak ve yanında bir tabloya yazılacak

ekte tablo mevcut

tsk ederim

 

[cenk e.]

Merhaba, şu formülü F3 hücresine yapıştırıp aşağı doğru kopyalayın.

=EĞERSAY(A:A;E3)

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub tekrarları59()
Dim sat As Long, z As Object, liste(), i As Long
Sheets("Sayfa1").Select
sat = Cells(Rows.Count, "A").End(xlUp).Row
liste = Range("A1:A" & sat).Value
Range("E3:F" & Rows.Count).ClearContents
sat = UBound(liste)
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To sat
    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
Range("E3").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Set z = Nothing
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub