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

Question

I am losing my mind over this and I know it is much more simple than I am making it.

I am looking to simply replace multiple occurrences of text with a hyperlink that is masked by the same text.

Scenario: We are moving to Google Classroom due to Covid-19 and we are thinking ahead to September. I can export pupils timetables in bulk to excel as HTML files (lets call this file timetables). I have a separate file with a list of all class names and the links for the Google Classrooms (lets call this one classes). I have copied these values into 'Sheet1' of the timetable file for the code below.

If I can use the classes list to search for all occurrences of the classes in the timetables then replace them with the hyperlink to the google classroom but I want it to appear as the classname.

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.

I have been trying this code that I found but cannot get a working hyperlink in the "replace" element.

'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

Help is appreciated.

3 : EDIT: Example timetable file

Answer 1

Try this. It appears that the link requires the full address including "https".

I mocked up a two-column table and a few values to test.

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

Before

After

Links table