|
これでどうでしょーか ?
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
|
|