excel - 保护工作表时无法使用超链接，不允许用户选择锁定的单元格

Question

我有一个工作表，其中有一堆动态超链接，这些超链接根据下拉菜单进行更改。仅具有下拉菜单的单元格被解锁。我未选中“选择锁定单元格”，这样当我保护工作表时，用户只能选择下拉菜单。不幸的是，当我这样做时，超链接不再可用。

有人知道如何解决这个问题吗？

更新*

根据要求，我的动态超链接单元格的代码:

=IF(ISNA(MATCH(B4,'Data Sheet'!A2:A103,0)),"",HYPERLINK(VLOOKUP(B4,'Data Sheet'!A:S,7,FALSE),VLOOKUP(B4,'Data Sheet'!A:S,5,FALSE)&" - "&VLOOKUP(B4,'Data Sheet'!A:S,6,FALSE)))

1) 单元格 B4 是用户选择特定选项的下拉菜单。超链接根据此选择而变化。

2)“数据表”是一个单独的表，其中包含数组中的所有引用数据。

这基本上是说:B4 中的值与我的数据图表中的第一列匹配吗？如果是这样，请使用超链接公式，通过 VLOOKUP 将相应的 URL 插入到公式中。

Answer 1

这是我对设置和要求的理解:

设置

• 有一个 protected 工作表，其中包含一个下拉菜单，可更新包含 VLOOKUP\HYPERLINK 公式的其他单元格。

• 工作表中的所有单元格(下拉菜单除外)均受到保护。

• 包含 VLOOKUP\HYPERLINK 公式的单元格的值可能等于 www 地址或空白，具体取决于下拉菜单的值。因此，所有超链接都指向网页或为空白。

• 工作表EnableSelection设置为xlUnlockedCells，这确定一旦工作表受到保护，“只能选择解锁的单元格。”

  <

要求 - 需要维护工作表 protected ，以保护包括 VLOOKUP\HYPERLINK 公式在内的所有内容。

• 需要允许用户选择\仅激活未 protected 细胞，主要是出于美观原因并提供专业的产品。

此解决方案使用以下资源

• HYPERLINK 函数
• UDF(用户定义函数)
• 两个公共(public)变量和
• Worksheet_BeforeDoubleClick 事件

When an UDF is wrapped into a HYPERLINK function it causes that every time the mouse hovers over the cell containing the combined formula of HYPERLINK(UDF,[FriendlyName]) the UDF is triggered.

我们将使用公共(public)变量来保存LinkLocation，稍后根据用户的决定使用超链接。

还有第二个公共(public)变量，用于设置LinkLocation上次更新的时间。

我们将模仿超链接“正常”激活的方式:

• 用户选择一个单元格并单击所选单元格中的超链接。

• 用户将鼠标悬停在带有超链接的单元格上(UDF 将 LinkLocation 和时间提供给公共(public)变量)和 DoubleClicks 单元格(触发工作表事件跟随超链接，首先验证 LinkLocation 最后更新的时间以确保它仍然是实际的，并清除 LinkLocation > 变量)。

首先，我们需要确保工作表中用于生成动态超链接的公式具有适当的结构:

假设当前的 VLOOKUP\HYPERLINK 公式具有以下结构: (由于未提供实际公式，因此必须基于假设进行计算)

=IFERROR( HYPERLINK( VLOOKUP( DropDownCell , Range , Column, False ), FriendlyName ), "" )

我们需要将该公式更改为以下结构:

=IFERROR( HYPERLINK( UDF( VLOOKUP( DropDownCell , Range , Column, False ) ), FriendlyName ), "" )

以下过程负责修改公式结构，使其适合所提出的解决方案。 建议将两者复制到名为“Maintenance”的单独模块中。

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

这些是公共(public)变量和 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

并使用动态生成的超链接将此过程复制到 protected 工作表的模块中。

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