| |
Sub Test()
Application.ScreenUpdating = False
With Range("A1", Range("A65536").End(xlUp)).Offset(, 4)
.Formula = "=MATCH($A1,$C:$C,0)"
.Offset(, 1).Formula = "=$B1"
End With
With Range("C1", Range("C65536").End(xlUp)).Offset(, 4)
.Formula = "=MATCH($C1,$A:$A,0)"
.Offset(, 1).Formula = "=$D1"
End With
Range("E:G").Copy
Range("E1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
On Error Resume Next
Intersect(Range("E:E").SpecialCells(2, 16).EntireRow, Range("E:F")) _
.Delete xlShiftUp
Intersect(Range("G:G").SpecialCells(2, 16).EntireRow, Range("G:H")) _
.Delete xlShiftUp
Application.ScreenUpdating = True
End Sub
ざっとこんな感じで、出来ると思います。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
