將一列中的 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