MS Excel Найти текст и заменить на гиперссылку

Question

Я схожу с ума по этому поводу и знаю, что это гораздо проще, чем я делаю это.

Я хочу просто заменить несколько вхождений текста гиперссылкой, маскируемой одним и тем же текстом. .

Сценарий. Мы переходим в Google Classroom из-за Covid-19 и ожидаем сентября. Я могу экспортировать расписания учеников оптом, чтобы превзойти их как HTML файлы (давайте назовем этот файл расписаниями). У меня есть отдельный файл со списком всех названий классов и ссылками на Google Classrooms (назовем это одним классом). Я скопировал эти значения в «Лист1» файла расписания для приведенного ниже кода.

Если я могу использовать список классов для поиска всех экземпляров классов в расписаниях, то замените их гиперссылкой на Google Classroom, но я хочу, чтобы он отображался как имя класса.

Это изображение файла расписания. Это одно расписание, но файл продолжает один и тот же шаблон для разных учеников

Это изображение файла списка классов. Представьте, что все перечисленные классы и ссылки были действительными.

Я пробовал этот код, который я нашел, но не могу получить работающую гиперссылку в элементе "replace".

'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

До

После

Таблица ссылок