VLOOKUP和超链接不工作

选项1:表内自定义项

您可以使用以下代码: Igor (稍作修改)在标准模块中,作为基于工作表的方式,通过用户定义函数(UDF)更新URL GetUrl ,包裹在 HYPERLINK 功能,以确保您有一个可点击的链接。

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(计算)的刷新绑定到事件,以确保超链接文本明显更新。

例如,在包含自定义项的工作表中,您可以通过 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 ,包裹在 超链接 函数,它指向 A1 .

功能代码将放在标准模块中:

按 + F11层 要打开VBE,然后在project explorer窗口中,右键单击 Insert Module 然后在出现的模块中输入代码,例如:。

对于包含函数的每个工作表,触发器代码(因此超链接文本更新)将进入工作表代码窗口,例如,如果工作表4具有 获取URL 在中,您将在“图纸代码”窗口中输入以下内容:

正如我在评论中所说,这可以被放入一个函数中,该函数在激活每个工作表时调用。

选项2:与宏相关联的工作表中的按钮,提示用户选择包含旧URL和新URL的范围

或者,以下内容并没有得到优化,但我很乐意在其他人发表评论时更新。这将是一个简单的过程,你放在一个标准模块,你附加到一个按钮(谷歌分配宏按钮在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无法构建正确的超链接。

我通过在颜色指南上创建两列来解决这个问题。第一个存储颜色的名称。第二个存储了超链接。在第二张纸上,我想将名称和超链接拉入其中,我使用了以下公式:

=HYPERLINK(VLOOKUP(C3, 'Color Guide'!$A:$D, 4), VLOOKUP(C3, 'Color Guide'!$A:$D, 3))

第一个VLOOKUP拉取链接位置,第二个VLOOKUP拉取“友好名称”。这是伟大的作品和自动更新链接时,它是在颜色指南更改!