Private Sub CommandButton1_Click()
Dim tablo, d As Object, i&, x$
tablo = [A1].CurrentRegion.Resize(, 4)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = LCase(tablo(i, 1) & Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3))
d(x) = d(x) + 1
Next
For i = 2 To UBound(tablo)
x = LCase(tablo(i, 1) & Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3))
tablo(i, 4) = d(x)
Next
[d1].Resize(UBound(tablo)) = Application.Index(tablo, , 4)
End Sub