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

Question

我正在为此失去理智，我知道这比我做的要简单得多。

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

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

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

This is an image of the timetable file. This is one timetable but the file continues the same pattern for different pupils

This is an image of the classlist file. Imagine there were all classes listed and links were valid.

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

'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:EDIT: Example timetable file

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

之前

之后

链接表