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

Question

在 Excel 宏方面需要一些帮助——我目前正在努力编写一个结合了所有三个进程的宏。 我有两张工作表：工作表 1 包含一列，每个单元格中有多个 ID，用逗号分隔（go 最多可以在一个单元格中包含 30 个 ID），工作表 2 包含每个 ID 的数据。

这是我要实现的顺序：

1. 将工作表 1 中的 ID 拆分为单独的单元格
2. 将每个分离的 ID 与其在工作表 2 中的行匹配，复制第 6 列和第 7 列的值并将其添加到工作表 1 的相应单元格中。
3. 将超链接应用到最后一个单元格。

例如，这里是工作表 1 和 2 中的一行当前的样子：

第 1 张

ID
123456、789123

工作表 2

ID	地位	Class
123456	进行中	一种
789123	完毕	乙

这是我希望 output 在宏运行时查找工作表 1 的内容：

ID
123456、789123	123456，进行中，A	789123，完成，B

我的代码非常糟糕，但这就是我所拥有的：

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

尝试这个：

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