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

Question

我对此一无所知，我知道这比我做的要简单得多。

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

场景：由于Covid-19，我们正移至Google课堂，我们正在考虑9月。我可以将学生时间表批量导出为Excel文件（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

感谢您的帮助。

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

之前

之后

链接表