MS Excel 查找文本并替换为超链接

Question

我对此失去了理智，我知道这比我做的要简单得多。

我希望用被相同文本掩盖的超链接简单地替换多次出现的文本。

情景：由于 Covid-19，我们正在迁移到 Google 课堂，我们正在考虑提前到 9 月。 我可以将学生的时间表批量导出到 excel 作为 HTML 文件（让我们将此文件称为时间表）。 我有一个单独的文件，其中列出了所有 class 名称和 Google 课堂的链接（让我们称之为一个类）。 我已将这些值复制到以下代码的时间表文件的“Sheet1”中。

如果我可以使用课程列表搜索时间表中所有出现的课程，然后将它们替换为指向 google 教室的超链接，但我希望它显示为类名。

这是时间表文件的图像。 这是一个时间表，但文件对不同的学生继续相同的模式

这是类列表文件的图像。 想象一下，列出了所有类并且链接都是有效的。

我一直在尝试我找到的这段代码，但无法在“替换”元素中获得有效的超链接。

'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant

'Create variable to point to your table
  Set tbl = Worksheets("Sheet1").ListObjects("Table2")

'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)

'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then
          sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
        End If
      Next sht
  Next x

End Sub

帮助表示赞赏。

3 ：编辑：示例时间表文件

Answer 1

尝试这个。 该链接似乎需要完整的地址，包括“https”。

我模拟了一个包含两列的表格和一些要测试的值。

Sub x()

Dim r As Range, t As ListObject, rFind As Range, s As String

With Worksheets("Sheet1")
    Set t = .ListObjects("Table1")
    For Each r In t.ListColumns(1).DataBodyRange 'loop through first column of table
        Set rFind = .Range("A:C").Find(What:=r.Value, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'look for value
        If Not rFind Is Nothing Then
            s = rFind.Address 'store address of first cell
            Do
                .Hyperlinks.Add Anchor:=rFind, Address:=r.Offset(, 1).Value, SubAddress:="", ScreenTip:=r.Offset(, 1).Text, TextToDisplay:=r.Value 'add hyperlink
                Set rFind = .Range("A:C").FindNext(rFind) 'look for next instance
            Loop While rFind.Address <> s 'keep going until back to first case
        End If
    Next r
End With

End Sub

前

后

链接表