Fórmula Excel

Te dejo este código que haría lo que creo entenderte.
Un saludo
Option Explicit
Sub buscarRepetidos()
    ReDim m(1 To 1000) As Double
    Dim n As Integer
    Dim i As Integer
    Dim j As Integer
    Dim aux
    n = 0
    For i = 1 To 3
        For j = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
            aux = Trim$(Cells(j, i))
            If aux <> "" And IsNumeric(aux) Then
                ' Sabemos que el contenido de la celda es un número. Lo añadimos a nuestra lista
                n = n + 1
                If n > UBound(m) Then ReDim Preserve m(1 To n + 99) As Double
                m(n) = Cells(j, i)
            End If
            DoEvents ' Para que el proceso no se quede pillado
        Next j
    Next i
    ordenarVector m(), n
    ' Borramos el contenido de la columna "D"
    Range("D1:D" & Format$(Cells.SpecialCells(xlCellTypeLastCell).Row)).Clear
    j = 0
    For i = 2 To n
        If m(i) = m(i - 1) Then ' Se está repitiendo
            If i = 2 Then ' Es el primero que se repite
                j = j + 1
                Cells(j, 4) = m(i)
              Else
                ' I es mayor que 2... comprobamos si m(i-2) es un valor distinto. Si fuera igual
                ' significaría que ya se ha escrito el duplicado
                If m(i) <> m(i - 2) Then
                    j = j + 1
                    Cells(j, 4) = m(i)
                End If
            End If
        End If
    Next i
    MsgBox "Proceso terminado"
End Sub
Private Sub ordenarVector(ByRef x() As Double, ByVal n As Long)
    ReDim nh(32) As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim nw As Long
    Dim f As Double
    Dim w As Double
    Dim nr As Long
    Dim v As Long
    ' copia estructurada del código FORTRAM
    k = 1
    l = 1
    nr = n
    Do
        i = l
        j = nr
        nw = Int((nr / 1# + l / 1# + 1) / 2)
        f = x(nw)
        ' Fase de partición de la lista
        Do
            Do While x(i) < f
                i = i + 1
            Loop
            Do While x(j) > f
                j = j - 1
            Loop
            If i <= j Then
                w = x(i): x(i) = x(j): x(j) = w
                i = i + 1
                j = j - 1
            End If
        Loop Until i > j
        ' Fase de búsqueda
        If (j - l) < (nr - i) Then
            If i < nr Then
                nh(k) = i
                k = k + 1
                nh(k) = nr
                k = k + 1
            End If
            nr = j
          Else
            If l < j Then
                nh(k) = l
                k = k + 1
                nh(k) = j
                k = k + 1
            End If
            l = i
        End If
        If l >= nr Then
            k = k - 1
            nr = nh(k)
            k = k - 1
            If k >= 1 Then l = nh(k)
        End If
    Loop Until k < 1
End Sub

Gracias por la respuesta.
Tienes que perdonar mi poco conocimiento de excel, pero ¿cómo meto este Código?
Gracias y siento mi poco nivel