这是我对设置和要求的理解：
设置
有一个带有下拉菜单的受保护工作表，用于更新包含 VLOOKUP\HYPERLINK 公式的其他单元格。
工作表中的所有单元格（不包括下拉菜单）都受到保护。
包含 VLOOKUP\HYPERLINK 公式的单元格的值可能等于 www 地址或空白，具体取决于下拉菜单的值。因此，所有超链接都指向网页或为空白。
工作表EnableSelection 设置为xlUnlockedCells，这决定了一旦工作表受到保护，“只能选择未锁定的单元格”。
要求
- 需要保护工作表以保护包括 VLOOKUP\HYPERLINK 公式在内的所有内容。
- 需要允许用户选择\仅激活未受保护的细胞，主要是出于美观原因并提供专业产品。
此解决方案使用以下资源
-
HYPERLINK 函数
-
UDF（用户定义函数）
- 两个
Public Variables和
-
Worksheet_BeforeDoubleClick 事件
当 UDF 被包装到 HYPERLINK 函数中时，会导致
每次鼠标悬停在包含组合的单元格上时
HYPERLINK(UDF,[FriendlyName]) 的公式触发了UDF。
我们将使用Public Variable 来保存LinkLocation，以便稍后根据用户决定使用超链接。
第二个Public Variable 设置LinkLocation 上次更新的时间。
我们将模仿“正常”激活超链接的方式：
首先，我们需要确保工作表中用于生成动态超链接的公式具有适当的结构：
假设当前的 VLOOKUP\HYPERLINK 公式具有以下结构：
（必须根据假设工作，因为没有提供实际公式）
=IFERROR( HYPERLINK( VLOOKUP( DropDownCell , Range , Column, False ), FriendlyName ), "" )
我们需要将该公式更改为以下结构：
=IFERROR( HYPERLINK( UDF( VLOOKUP( DropDownCell , Range , Column, False ) ), FriendlyName ), "" )
以下过程负责修改公式结构以使其适合所提出的解决方案。 建议将两者复制到一个名为“维护”的单独模块中。
Option Explicit
Private Sub Wsh_FmlHyperlinks_Reset()
Const kWshPss As String = "WshPssWrd"
Const kHypLnk As String = "HYPERLINK("
Dim WshTrg As Worksheet, rHyplnk As Range
Dim rCll As Range, sHypLnkFml As String
Dim sOld As String, sNew As String
Rem Application Settings
Application.EnableEvents = False
Application.ScreenUpdating = False
Rem Set & Unprotect Worksheet
Set WshTrg = ActiveSheet
WshTrg.Unprotect kWshPss
Rem Find Hyperlink Formulas
If Not (Rng_Find_Set(WshTrg.UsedRange, _
rHyplnk, kHypLnk, xlFormulas, xlPart)) Then Exit Sub
If rHyplnk Is Nothing Then Exit Sub
Rem Add Hyperlinks Names
For Each rCll In rHyplnk.Cells
With rCll
sHypLnkFml = .Formula
sOld = "HYPERLINK( VLOOKUP("
sNew = "HYPERLINK( Udf_HypLnkLct_Set( VLOOKUP("
sHypLnkFml = Replace(sHypLnkFml, sOld, sNew)
sOld = ", FALSE ),"
sNew = ", FALSE ) ),"
sHypLnkFml = Replace(sHypLnkFml, sOld, sNew)
.Formula = sHypLnkFml
End With: Next
Rem Protect Worksheet
WshTrg.EnableSelection = xlUnlockedCells
WshTrg.Protect Password:=kWshPss
Rem Application Settings
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function Rng_Find_Set(rInp As Range, rOut As Range, _
vWhat As Variant, eLookIn As XlFindLookIn, eLookAt As XlLookAt) As Boolean
Dim rFound As Range, sFound1st As String
With rInp
Set rFound = .Find( _
What:=vWhat, After:=.Cells(1), _
LookIn:=eLookIn, LookAt:=eLookAt, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not (rFound Is Nothing) Then
sFound1st = rFound.Address
Do
If rOut Is Nothing Then
Set rOut = rFound
Else
Set rOut = Union(rOut, rFound)
End If
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFound1st
End If: End With
Rem Set Results
If Not (rOut Is Nothing) Then Rng_Find_Set = True
End Function
这些是公共变量和 UDF。 建议将它们复制到单独的模块中。
Option Explicit
Public psHypLnkLoct As String, pdTmeNow As Date
Public Function Udf_HypLnkLct_Set(sHypLnkFml As String) As String
psHypLnkLoct = sHypLnkFml
pdTmeNow = Now
End Function
并且将这个过程复制到受保护工作表的模块中，并带有动态生成的超链接。
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Now = pdTmeNow And psHypLnkLoct <> Empty Then
ThisWorkbook.FollowHyperlink Address:=psHypLnkLoct, NewWindow:=True
End If
End Sub