ML089

Sub ex1()
    Arr = Sheet1.Range("A1").CurrentRegion
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Arr)
        d(Left(Arr(i, 1), 6)) = Arr(i, 2)
    Next
    Sheet2.[A1:B65536].ClearContents
    Sheet2.[A1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

ML089

¦^´_ 4# rouber590324
­n¸ß°Ý¡A½Ð©ó°ÝÃD¤U¤è«ö¦^ÂÐÁä

¨úA-FÄæ¸ê®Æ
Sub ex2()
    Arr = Sheet1.Range("A1").CurrentRegion
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Arr)
        d(Left(Arr(i, 1), 6)) = Array(Arr(i, 1), Arr(i, 2), Arr(i, 3), Arr(i, 4), Arr(i, 5), Arr(i, 6))
    Next
    Sheet2.[A1:F65536].ClearContents
    Sheet2.[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
End Sub