­ã´£³¡ªL

Sub Ext()
Dim xR As Range, d, R&, C&
Range([E!A1], Sheets("E").UsedRange).Offset(4, 11).ClearContents
Set d = CreateObject("Scripting.Dictionary")
For Each xR In Range([E!D5], [E!D65536].End(xlUp))
    If xR <> "" Then d(xR & "") = xR.Row
Next
For Each xR In Range([DATA!E5], [DATA!E65536].End(xlUp))
    R = d(xR & ""):   If R = 0 Then GoTo 101
    d(xR & "//") = d(xR & "//") + 2:  C = d(xR & "//")
    [E!L1].Cells(R, C - 1).Resize(1, 2) = Array(xR(1, -2), xR(1, -3))
101: Next
End Sub