| 
    
     |  | これでどうでしょーか ? 
 Sub test()
 Dim C As Range
 Dim Lr As Long, Cnt As Long
 
 Range("C:C").ClearContents
 For Each C In Range("A1", Range("A65536").End(xlUp))
 Lr = Range("C65536").End(xlUp).Row + 1
 Cnt = WorksheetFunction _
 .CountIf(Range("B:B"), C.Value)
 If Cnt < 2 Then
 Cells(Lr, 3).Value = C.Value
 Else
 Cells(Lr, 3).Resize(Cnt).Value = C.Value
 End If
 Next
 For Each C In Range("B1", Range("B65536").End(xlUp))
 If IsError(Application.Match(C.Value, Range("A:A"), 0)) Then
 Range("C65536").End(xlUp).Offset(1).Value = C.Value
 End If
 Next
 Range("C1").Delete xlShiftUp
 End Sub
 
 |  |