excel - MS Excel 查找文本并替换为超链接
问题描述
我对此失去了理智,我知道这比我做的要简单得多。
我希望用被相同文本掩盖的超链接简单地替换多次出现的文本。
情景:由于 Covid-19,我们正在迁移到 Google 课堂,我们正在考虑提前到 9 月。我可以将学生的时间表批量导出为 HTML 文件(让我们将此文件称为时间表)。我有一个单独的文件,其中列出了所有班级名称和 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
帮助表示赞赏。
解决方案
尝试这个。该链接似乎需要完整的地址,包括“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
前
后
链接表
推荐阅读
- python - 用数据填充两个单独的数组?
- ios - iOS Swift:如何从我的应用程序中实现“兑现”方法?
- python - 提高pycharm速度
- linux - 脚本不会自动从 root 切换到普通用户
- python - This issue about keras model and how to compile the model
- twitter-bootstrap - CSS Bootstrap 两列布局
- php - 如何解决 XAMPP 中的禁止访问问题
- c# - C# 事件订阅者排队
- pandas - 如何将 Keras 输入的形状纠正为 3D 数组
- c - 为什么 FREAD 在 Linux 上给出错误,但在 Windows 上却没有?