删除重复项并按名称排列

Question

我在A中有一个代码列表，在B和C中有图像链接。

我想做的是删除重复项，并将唯一链接排列在单个列中，并给它们一个系列名称，如图所示，在图像链接1之前的code_1和在链接2之前的code_2不递增。

我是宏的新手，因此无法考虑解决方案。

我正在尝试使用此代码删除重复项，但是对于如何在链接之前放置名称一无所知。

Sub tgr()

    Dim wb As Workbook
    Dim wsDest As Worksheet
    Dim rData As Range
    Dim rArea As Range
    Dim aData As Variant
    Dim i As Long, j As Long
    Dim hUnq As Object

    'Prompt to select range.  Uniques will be extracted from the range selected.
    'Can select a non-contiguous range by holding CTRL
    On Error Resume Next
    Set rData = Application.InputBox("Select range of names where unique names will be extracted:", "Data Selection", Selection.Address, Type:=8)
    On Error GoTo 0
    If rData Is Nothing Then Exit Sub   'Pressed cancel

    Set hUnq = CreateObject("Scripting.Dictionary")
    For Each rArea In rData.Areas
        If rArea.Cells.Count = 1 Then
            ReDim aData(1 To 1, 1 To 1)
            aData(1, 1) = rArea.Value
        Else
            aData = rArea.Value
        End If

        For i = 1 To UBound(aData, 1)
            For j = 1 To UBound(aData, 2)
                If Not hUnq.Exists(aData(i, j)) And Len(Trim(aData(i, j))) > 0 Then hUnq(Trim(aData(i, j))) = Trim(aData(i, j))
            Next j
        Next i
    Next rArea

    Set wb = rData.Parent.Parent    'First parent is the range's worksheet, second parent is the worksheet's workbook
    Set wsDest = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    wsDest.Range("A1").Resize(hUnq.Count).Value = Application.Transpose(hUnq.Items)

End Sub