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

Question

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

这是我要实现的顺序：

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

例如，Sheet 1 和 2 中的一行当前看起来像这样：

Sheet 1

ID
123456, 789123

Sheet 2

ID	Status	Class
123456	In Progress	A
789123	Done	B

这就是我希望在宏运行时输出查找 Sheet1 的内容：

ID
123456, 789123	123456, In Progress, A	789123, Done, 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

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

Match IDs in a column (comma delimited string of IDs per cell) to another sheet, pull the relevant values over & apply hyperlink

excel

vba