将一列中的 ID（每个单元格以逗号分隔的 ID 字符串）匹配到另一个工作表，将相关值拉过来并应用超链接

Question

Need some help with an Excel macro-- I'm currently struggling to write a macro that combines all three processes. I have two sheets: Sheet 1 contains a column with multiple IDs in each cell delimited by commas (can go up to like 30 IDs in one cell), Sheet 2 contains data for each of the IDs.

Here's the sequence that I'm trying to achieve:

1. De-concatenate IDs in Sheet 1 into separate cells
2. Match each of the de-concatenated IDs to its row in Sheet 2, copy over and add values from column 6 and 7 to Sheet 1's respective cell.
3. Apply a hyperlink to the final cell.

For example, here's what a row in Sheet 1 & 2 currently look like:

Sheet 1

ID
123456, 789123

Sheet 2

ID	Status	Class
123456	In Progress	A
789123	Done	B

And here's what I'd like the output to look for Sheet 1 when the macro runs:

ID
123456, 789123	123456, In Progress, A	789123, Done, B

My code is super off, but here's what I have:

Set wb = ThisWorkbook
Dim sel As Range
Set sel = Selection
Dim arr() As String
Dim cell As Range
Dim i As Long

Set wsCheck = wb.Sheets("2")

 'Column N (IDs)
wb.Sheets("1").Columns("N:N").Select
For Each cell In sel
    arr = Split(cell, ",")

    For i = 0 To UBound(arr)
        m = Application.Match("*" & arr(i) & "*", wsCheck.Columns(1), 0)
            If Not IsError(m) Then
                cell.Offset(0, i + 1).Value = wsCheck.Cells(m, 6).Value & wsCheck.Cells(m, 7).Value
                cell.Parent.Hyperlinks.Add Anchor:=cell.Offset(0, i + 1), Address:="URL" & arr(i), TextToDisplay:=arr(i)
            End If
          
    Next i
Next cell

Answer 1

Try this:

Sub test()

    Dim wb As Workbook, arr, ws As Worksheet, wsCheck As Worksheet
    Dim cell As Range
    Dim i As Long, v, m
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("1")
    Set wsCheck = wb.Sheets("2")
    
    If Not TypeOf Selection Is Range Then Exit Sub 'make sure a range is selected
    If Selection.Worksheet.Name <> ws.Name Then Exit Sub '...on the correct sheet
    
    For Each cell In Selection.EntireRow.Columns("N").Cells
        arr = Split(cell.Value, ",")
    
        For i = 0 To UBound(arr)
            v = CLng(Trim(arr(i))) 'remove spaces and convert to number
            m = Application.Match(v, wsCheck.Columns(1), 0)
            If Not IsError(m) Then
                With cell.Offset(0, i + 1)
                    .Value = Join(Array(v, wsCheck.Cells(m, 6).Value, _
                                        wsCheck.Cells(m, 7).Value), ",")
                    .Parent.Hyperlinks.Add Anchor:=.Cells(1), _
                       Address:="", _
                       SubAddress:=wsCheck.Cells(m, 1).Address(0, 0, xlA1, True), _
                       TextToDisplay:=.Value
                End With
            End If
              
        Next i
    Next cell
End Sub