VLOOKUP 和 HYPERLINK 不起作用
VLOOKUP and HYPERLINK not working
我有一个参考 sheet 称为颜色指南，用于跟踪油漆颜色和这些油漆颜色的链接。它看起来像这样：
我有大约 85 sheets，每个代表一栋建筑，每栋建筑都有一组适用于不同房间的允许油漆颜色选择。它看起来像这样：
我想要做的是：当我在颜色指南 sheet（第一张图片）上更新我的外部超链接时，我需要相同的超链接来更新每个建筑物 sheet。我一直试图通过 VLOOKUP 来实现这一点，但超链接并没有停止。我在网上看到我可以将 HYPERLINK 公式与 VLOOKUP 公式链接在一起。这就是它的样子，包括当我点击图片 2 中的超链接时出现的错误：
我应该怎么办？我已经在这个项目上工作了好几天，但我无法让它工作。我在这里看到的其他答案似乎无法解决问题。
选项 1：在 sheet UDF
您可以在标准模块中使用 Igor（稍作修改）的以下代码作为一种基于工作sheet 的方式，通过用户定义的函数 (UDF) 更新 Urls GetUrl, 包装在 HYPERLINK 函数中，以确保您有一个可点击的 link.
标准模块中的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
在 sheet2 中的单元格中进行部署的位置，例如以下
=HYPERLINK(GetURL(Sheet1!A1))
并且 sheet 一个单元格 A1 正在更新 hyperlink。
您需要将 UDF（计算）的刷新与事件相关联，以确保 hyperlink 文本明显更新。
例如，在包含 UDF 的 sheet 中，您可以通过 Greg Glynn 强制重新计算。当然，您可以尝试找到一种有效的方法来做到这一点。
Private Sub Worksheet_Activate()
Cells.Replace What:="=", Replacement:="=", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
如上代码所述：
单元格 A1 正在更新 hyperlink
Cell A3（可能是不同 sheet 中的一个单元格）具有函数 GetURL ，包装在 HYPERLINK 函数内，指向 A1.
函数代码将放在标准模块中：
按Alt + F11打开VBE然后在项目资源管理器window中右击Insert Module 然后将代码输入到出现的模块中，例如
触发器代码（因此 hyperlink 文本更新）将进入工作sheet 代码 window，每个 sheet 包含函数，例如如果 sheet 4 中有 GetUrl 函数，您将输入 sheet 代码 window 如下：
正如我在评论中所说，这可以放入每个 sheet 被激活时调用的函数中。
选项 2：工作中的按钮sheet 与提示用户select 包含旧网址和新网址的范围相关联的宏
或者，以下未优化，但我很乐意在其他人发表评论时进行更新。这只是您放置在附加到按钮的标准模块中的一个过程（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 列是通过代码添加的）：
添加表单控件按钮：
它会自动弹出一个 window，然后您可以在其中分配更新 link 程序：
我的解决方案：
问题是除了使用 VLOOKUP 之外，HYPERLINK 无法构建正确的 hyperlink。
我通过在颜色指南上创建 2 列解决了这个问题。第一个存储颜色的名称。第二个存储 hyperlink。在第二个 sheet 上，我想将名称和 hyperlink 拉入其中，我使用了以下公式：
=HYPERLINK(VLOOKUP(C3, 'Color Guide'!$A:$D, 4), VLOOKUP(C3, 'Color Guide'!$A:$D, 3))
第一个 VLOOKUP 提取了 link 位置，第二个 VLOOKUP 提取了 'friendly name'。这很好用，并且在 link 在颜色指南上更改时自动更新！
我有一个参考 sheet 称为颜色指南，用于跟踪油漆颜色和这些油漆颜色的链接。它看起来像这样：
我有大约 85 sheets，每个代表一栋建筑，每栋建筑都有一组适用于不同房间的允许油漆颜色选择。它看起来像这样：
我想要做的是：当我在颜色指南 sheet（第一张图片）上更新我的外部超链接时，我需要相同的超链接来更新每个建筑物 sheet。我一直试图通过 VLOOKUP 来实现这一点，但超链接并没有停止。我在网上看到我可以将 HYPERLINK 公式与 VLOOKUP 公式链接在一起。这就是它的样子，包括当我点击图片 2 中的超链接时出现的错误：
我应该怎么办？我已经在这个项目上工作了好几天，但我无法让它工作。我在这里看到的其他答案似乎无法解决问题。
选项 1：在 sheet UDF
您可以在标准模块中使用 Igor（稍作修改）的以下代码作为一种基于工作sheet 的方式，通过用户定义的函数 (UDF) 更新 Urls GetUrl, 包装在 HYPERLINK 函数中，以确保您有一个可点击的 link.
标准模块中的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
在 sheet2 中的单元格中进行部署的位置，例如以下
=HYPERLINK(GetURL(Sheet1!A1))
并且 sheet 一个单元格 A1 正在更新 hyperlink。
您需要将 UDF（计算）的刷新与事件相关联，以确保 hyperlink 文本明显更新。
例如，在包含 UDF 的 sheet 中，您可以通过 Greg Glynn 强制重新计算。当然，您可以尝试找到一种有效的方法来做到这一点。
Private Sub Worksheet_Activate()
Cells.Replace What:="=", Replacement:="=", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
如上代码所述：
单元格 A1 正在更新 hyperlink
Cell A3（可能是不同 sheet 中的一个单元格）具有函数 GetURL ，包装在 HYPERLINK 函数内，指向 A1.
函数代码将放在标准模块中：
按Alt + F11打开VBE然后在项目资源管理器window中右击Insert Module 然后将代码输入到出现的模块中，例如
触发器代码（因此 hyperlink 文本更新）将进入工作sheet 代码 window，每个 sheet 包含函数，例如如果 sheet 4 中有 GetUrl 函数，您将输入 sheet 代码 window 如下：
正如我在评论中所说，这可以放入每个 sheet 被激活时调用的函数中。
选项 2：工作中的按钮sheet 与提示用户select 包含旧网址和新网址的范围相关联的宏
或者，以下未优化，但我很乐意在其他人发表评论时进行更新。这只是您放置在附加到按钮的标准模块中的一个过程（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 列是通过代码添加的）：
添加表单控件按钮：
它会自动弹出一个 window，然后您可以在其中分配更新 link 程序：
我的解决方案：
问题是除了使用 VLOOKUP 之外，HYPERLINK 无法构建正确的 hyperlink。
我通过在颜色指南上创建 2 列解决了这个问题。第一个存储颜色的名称。第二个存储 hyperlink。在第二个 sheet 上，我想将名称和 hyperlink 拉入其中，我使用了以下公式：
=HYPERLINK(VLOOKUP(C3, 'Color Guide'!$A:$D, 4), VLOOKUP(C3, 'Color Guide'!$A:$D, 3))
第一个 VLOOKUP 提取了 link 位置，第二个 VLOOKUP 提取了 'friendly name'。这很好用，并且在 link 在颜色指南上更改时自动更新！