Sub ttt()
    Dim Ar(), i&, Dic As Object, R&
    Set Dic = CreateObject("Scripting.Dictionary")
    R = Cells(Rows.Count, 1).End(xlUp).Row
    Ar = Range("A2:A" & R).Value
    For i = 1 To UBound(Ar)
        If Not Dic.exists(Ar(i, 1)) Then
            Dic.Add Key:=Ar(i, 1), Item:=Ar(i, 1)
        End If
    Next
    Ar = Range("D2", Cells(Rows.Count, 4).End(xlUp)).Value
    For i = 1 To UBound(Ar)
        If Not Dic.exists(Ar(i, 1)) Then
            Dic.Add Key:=Ar(i, 1), Item:=Ar(i, 1)
            Cells(R + 1, 1).Value = Ar(i, 1): R = R + 1
'            Exit For ' если эту строчку убрать - выведет все сразу; а так - один пуск, одно значение.
        End If
    Next

    Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For Each c In Range("D3:D" & Cells(Rows.Count, 4).End(xlUp).Row)
    If c <> c.Offset(-1, 0) + 1 Then
    Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1) = c
    End If
    Next