Sub special_matching()
    Dim X() As Variant  '作業用
    Dim AA() As Long, BB() As Long
    Dim maxA As Long, maxB As Long
    Dim i As Long
    Dim A As Long, B As Long, D As Long, E As Long, F As Long

    ' A列データ取得
    X = Range(Range("A1"), Range("A1").End(xlDown))
    maxA = UBound(X): ReDim AA(maxA + 1)
    For i = 1 To maxA: AA(i) = X(i, 1): Next

    ' B列データ取得
    X = Range(Range("B1"), Range("B1").End(xlDown))
    maxB = UBound(X): ReDim BB(maxB + 1)
    For i = 1 To maxB: BB(i) = X(i, 1): Next

    A = 1: B = 1: D = 1: E = 1: F = 1  '各列のインデックス

    While A <= maxA And B <= maxB
        If AA(A) = BB(B) Then
            Cells(F, 6) = AA(A)
            F = F + 1
            While A < maxA And AA(A) = AA(A + 1)
                A = A + 1
            Wend
            A = A + 1
            While B < maxB And BB(B) = BB(B + 1)
                B = B + 1
            Wend
            B = B + 1
        ElseIf AA(A) < BB(B) Then
            Cells(D, 4) = AA(A)
            D = D + 1
            While A < maxA And AA(A) = AA(A + 1)
                A = A + 1
            Wend
            A = A + 1
        Else  ' If AA(A) > BB(B) Then
            Cells(E, 5) = BB(B)
            E = E + 1
            While B < maxB And BB(B) = BB(B + 1)
                B = B + 1
            Wend
            B = B + 1
        End If
    Wend

    While A <= maxA
    Cells(D, 4) = AA(A)
        A = A + 1
    Wend
    While B <= maxB
    Cells(E, 5) = BB(B)
        B = B + 1
    Wend
End Sub