我有一个名为颜色指南的参考表，用于跟踪油漆颜色和这些油漆颜色的链接。它看起来像这样：
我有大约 85 张纸，每张纸代表一栋建筑，每栋建筑都有一组适用于不同房间的允许油漆颜色选择。它看起来像这样：
我要做的是：当我在颜色指南表（第一张图片）上更新我的外部超链接时，我需要在每个建筑表上更新相同的超链接。我一直试图通过 VLOOKUP 来实现这一点，但超链接没有拉过来。我在网上读到我可以将 HYPERLINK 公式与 VLOOKUP 公式链接在一起。这就是它的样子，包括我点击图 2 中的超链接时出现的错误：
【问题讨论】：
标签： excel excel-formula vlookup excel-2016
选项 1：在工作表 UDF 中
您可以在标准模块中使用Igor（稍作修改）的以下代码作为基于工作表的方法，通过用户定义的函数 (UDF) GetUrl 更新 Urls，包装在 HYPERLINK 函数中，以确保您有一个可点击的链接。
标准模块中的UDF代码：
Option Explicit
Function GetURL(cell As Range, Optional default_value As Variant) as hyperlink
'Lists the Hyperlink Address for a Given Cell
'If cell does not contain a hyperlink, return default_value
If (cell.Hyperlinks.Count <> 1) Then
GetURL = default_value
Else
GetURL = cell.Hyperlinks(1).Address
End If
End Function
通过在工作表 2 中的单元格中进行部署，例如，以下
=HYPERLINK(GetURL(Sheet1!A1))
第一个单元格A1 的超链接正在更新。
您需要将 UDF（计算）的刷新与事件联系起来，以确保超链接文本明显更新。
例如，在包含 UDF 的工作表中，您可以通过Greg Glynn 来强制重新计算。当然，您可以尝试寻找一种有效的方法来做到这一点。
Private Sub Worksheet_Activate()
Cells.Replace What:="=", Replacement:="=", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
如上述代码所述：
单元格A1 的超链接正在更新
单元格A3（可能是不同工作表中的单元格）具有函数GetURL，包裹在HYPERLINK函数内，指向A1。
功能代码将放在标准模块中：
按 Alt + F11 打开 VBE，然后在项目浏览器窗口中，右键单击Insert Module，然后在出现的模块中输入代码，例如
触发代码（因此超链接文本更新）将进入包含函数的每个工作表的工作表代码窗口，例如如果工作表 4 中有 GetUrl 函数，您将在工作表代码窗口中输入如下：
正如我在 cmets 中所说，这可以放入一个在激活每个工作表时调用的函数中。
选项 2：工作表中与宏关联的按钮，提示用户选择包含旧网址和新网址的范围
或者，以下未优化但我很高兴更新为其他芯片在 cmets 中。这只是您放置在附加到按钮的标准模块中的过程（Google 将宏分配给 Excel 中的按钮 - 您还需要将开发人员选项卡添加到功能区）
Option Explicit
Public Sub ReplaceLinks()
Dim linksArr()
Application.ScreenUpdating = False
Dim myRange As Range
Set myRange = Application.InputBox("Please select both columns containing range of hyperlinks to update", Type:=8)
If Not myRange Is Nothing And myRange.Columns.Count = 2 Then
linksArr = myRange.Value
Else
MsgBox "Please select a range of two columns"
Exit Sub
End If
ReDim Preserve linksArr(1 To UBound(linksArr), 1 To 3)
linksArr = ValidateUrls(linksArr)
Dim currentLink As Long
For currentLink = LBound(linksArr, 1) To UBound(linksArr, 1)
If linksArr(currentLink, 3) Then
UpdateMyHyperlink CStr(linksArr(currentLink, 1)), CStr(linksArr(currentLink, 2))
End If
Next currentLink
WriteValidationResults linksArr, myRange
End Sub
Private Function ValidateUrls(ByVal linksArr As Variant) As Variant
Dim currentLink As Long
For currentLink = LBound(linksArr, 1) To UBound(linksArr, 1)
linksArr(currentLink, 3) = IsURLGood(CStr(linksArr(currentLink, 1)))
Next currentLink
ValidateUrls = linksArr
End Function
Public Function IsURLGood(ByVal url As String) As Boolean
'https://www.experts-exchange.com/questions/27240517/vba-check-URL-if-it-is-active-or-not.html by m4trix
Dim request As WinHttpRequest
Set request = New WinHttpRequest
On Error GoTo IsURLGoodError
request.Open "HEAD", url
request.Send
IsURLGood = request.Status = 200
Exit Function
IsURLGoodError:
IsURLGood = False
End Function
Private Sub UpdateMyHyperlink(ByVal oldUrl As String, ByVal newUrl As String)
Dim ws As Variant
Dim hyperlink As Variant
For Each ws In ThisWorkbook.Worksheets
For Each hyperlink In ws.Hyperlinks
If hyperlink.Address = oldUrl & "/" Then
hyperlink.Address = Application.WorksheetFunction.Substitute(hyperlink.Address, oldUrl, newUrl)
hyperlink.TextToDisplay = newUrl
End If
Next
Next
End Sub
Private Sub WriteValidationResults(ByVal linksArr As Variant, ByRef myRange As Range)
Dim isUrlValidOutput As Range
Set isUrlValidOutput = myRange.Offset(, 2).Resize(myRange.Rows.Count, 1)
isUrlValidOutput = Application.Index(linksArr, , 3)
isUrlValidOutput.Offset(-1, 0).Resize(1) = "Valid URL"
End Sub
您可以按如下方式设置数据（通过代码添加 D 列）：
添加表单控制按钮：
它会自动弹出一个窗口，您可以在其中分配更新链接程序：
【讨论】：
我的解决方案：
问题是除了使用 VLOOKUP 之外，HYPERLINK 无法建立正确的超链接。
我通过在颜色指南上创建 2 列解决了这个问题。第一个存储颜色的名称。第二个存储超链接。在第二张纸上，我想将名称和超链接拉入其中，我使用了以下公式：
=HYPERLINK(VLOOKUP(C3, 'Color Guide'!$A:$D, 4), VLOOKUP(C3, 'Color Guide'!$A:$D, 3))
第一个 VLOOKUP 提取链接位置，第二个 VLOOKUP 提取“友好名称”。这很好用，并且在颜色指南上更改链接时会自动更新链接！
【讨论】：