我在众多工作表中有数百种形状的超链接。下面的代码非常适合全局更改所有这些工作表的超链接,因为我只是更改了超链接的一部分。如何使用一系列原始超链接(A2:A300)更改这些超链接,并使用相应的替换范围(B2:B300)?
Sub FixHyperlinks()
Dim wks As Worksheet
For Each Ws In Sheets
Ws.Activate
Dim hl As Hyperlink
Dim sOld As String
Dim sNew As String
Set wks = ActiveSheet
sOld = "part of old address"
sNew = "replacement to old address"
For Each hl In wks.Hyperlinks
hl.Address = Replace(hl.Address, sOld, sNew)
Next hl
Next Ws
End Sub
谢谢。
Application.Match
能够在列表(范围或数组)中查找值,并返回错误或该列表中的位置。
如果找到并更改了超链接,则A列中的相应条目将变为绿色文本。如果未找到超链接,其工作表的名称及其地址将显示在C和D列中。
Sub FixHyperlinks()
Dim listWS As Worksheet
Dim currentWS As Worksheet
Dim hl As Hyperlink
Dim foundRow As Variant
Dim writeRow As Long
Set listWS = ActiveWorkbook.Sheets(1)
writeRow = 2
For Each currentWS In ActiveWorkbook.Sheets
For Each hl In currentWS.Hyperlinks
foundRow = Application.Match(hl.Address, listWS.Range("A2:A300"), 0)
If IsNumeric(foundRow) Then
listWS.Range("A2:A300").Cells(foundRow).Font.Color = vbGreen
hl.Address = listWS.Range("B2:B300").Cells(foundRow).Value
Else
listWS.Cells(writeRow, "C").Value = currentWS.Name
listWS.Cells(writeRow, "D").Value = hl.Address
writeRow = writeRow + 1
End If
Next hl
Next currentWS
End Sub
没有必要激活每个工作表,因为您的“wks”已经指向每个工作表。