添加具有多个有效参考的目录超链接答案

【问题标题】：Adding TOC Hyperlinks with multiple valid references available添加具有多个有效参考的目录超链接
【发布时间】：2016-11-10 00:29:14
【问题描述】：

我目前希望通过向现有“目录”表添加超链接来扩展现有启用宏的工作簿的功能。工作簿的操作很像仪表板：“内容”工作表上的按钮命令激活从远程源提取模板的宏，将工作表名称更改为唯一，同时标识要添加的位置，将它们复制到本地工作簿，然后更新添加位置的内容表上位置列表的底部。

当我的位置在位置之间进行了多次相同计算的迭代，并且同一工作簿中最多包含 30 个工作表时，就会出现问题。最终用户需要花费时间单击所有选项卡以查找特定位置所需的特定计算。所以，我希望做的是在内容页面上创建一个超链接，链接到与相关位置相关的第一个计算。

例如，Location A 有 3 个与之关联的不同计算，而 Location B 有 4 个。我如何确定哪个工作表包含关联位置的第一个计算?

我的想法：我有一个排序代码（编辑：见下文）在添加一个新位置时实现，它对内容表进行排序，然后遍历整个工作簿，将名为 Location 的工作表分组X (Calc n) 并根据内容表上的新顺序将工作表组推到工作簿的后面。我认为这将是插入超链接的理想位置，但我不确定如何去做。也许声明并分配一个字符串变量当前选定位置的值，进行逻辑比较并计算分配给所述位置的工作表数量，在位置名称更改时重置计数器，并在超链接锚点中使用活动工作表时计数器等于 0？

编辑：

Dim Group_Sheets As Worksheet
Dim wSheet As Variant
Dim SortRng, rng As Range

Set SortRng = Range(Range("A6"), Range("A6").End(xlDown))
For Each rng In SortRng
    ReDim wSheet(0)
    For Each Group_Sheets In ThisWorkbook.Worksheets
        If Left(Group_Sheets.Name, Len(rng)) = rng Then
            wSheet(UBound(wSheet)) = Group_Sheets.Name
            ReDim Preserve wSheet(UBound(wSheet) + 1)
        End If
    Next
    ReDim Preserve wSheet(UBound(wSheet) - 1)
    With Worksheets(wSheet)
        .Select
        .Move after:=Worksheets(Worksheets.Count)
    End With
Next

【问题讨论】：

所以我做了一个临时解决方法，添加了一个超链接，其地址是添加位置时从模板复制的最后一张表。然而，这远非理想，因为如果最终用户删除链接的计算，它将无法更新超链接。在看到这个结果之后，我相信使用最后一张表也是可以接受的。感觉就像答案正盯着我的脸……我只是看不到它。

标签： excel vba

【解决方案1】：

在移动工作表组时添加超链接已解决问题。

Set SortRng = Range(Range("A6"), Range("A6").End(xlDown))
For Each rng In SortRng
    ReDim wSheet(0)
    For Each Group_Sheets In ThisWorkbook.Worksheets
        If Left(Group_Sheets.Name, Len(rng)) = rng Then
            wSheet(UBound(wSheet)) = Group_Sheets.Name
            ReDim Preserve wSheet(UBound(wSheet) + 1)
        End If
    Next
    ReDim Preserve wSheet(UBound(wSheet) - 1)
    With Worksheets(wSheet)
        .Select
        .Move after:=Worksheets(Worksheets.Count)
    End With
'Select the sheet to which the hyperlink directs HERE
    Sheets(Sheets.Count).Select
'Insert hyperlink HERE
    TOC_Sheet.Hyperlinks.Add Anchor:=rng.Offset(0, 1), _
        Address:="", SubAddress:="'" & ActiveSheet.Name & "'!A1", _
        ScreenTip:=ActiveSheet.Name, _
        TextToDisplay:="Link"
Next

【讨论】：