如何合并VBA代码实现Excel Index页工作表超链接与活动列表按行联动

问题需求 #

在Excel的「Index」工作表中，遍历除该表外的所有工作表，完成：

1. 为每个工作表名称添加超链接并列出
2. 列出对应工作表中的所有活动
3. 下一个工作表名称需显示在上一个工作表活动列表最后一行的下一行，格式示例：

Sheet     Activities
Sheet1    Act1
          Act2
          Act3
Sheet2    Act1
          Act2
Sheet3    Act1
          Act2

合并后的完整VBA代码 #

Sub GenerateSheetIndexWithActivities()
    Dim ws As Worksheet
    Dim indexWs As Worksheet
    Dim currentRow As Long
    Dim activityRange As Range
    Dim lastActivityRow As Long
    
    ' 初始化Index工作表对象，避免重复调用
    Set indexWs = ThisWorkbook.Worksheets("Index")
    ' 从第2行开始（假设第1行是表头）
    currentRow = 2
    
    ' 先清空Index表的旧数据（可选，根据需求保留）
    indexWs.Range("A2:B" & indexWs.Cells(indexWs.Rows.Count, "A").End(xlUp).Row).Clear
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Index" Then
            ' 1. 添加工作表超链接到A列当前行
            indexWs.Hyperlinks.Add _
                Anchor:=indexWs.Cells(currentRow, 1), _
                Address:="", _
                SubAddress:="'" & ws.Name & "'!A1", _
                TextToDisplay:=ws.Name
                
            ' 2. 获取当前工作表的活动列表（假设活动在B10到B100，可根据实际调整）
            With ws
                ' 找到B列从B10开始的最后一行非空单元格
                lastActivityRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                ' 确保不超过B100的范围
                If lastActivityRow > 100 Then lastActivityRow = 100
                If lastActivityRow >= 10 Then
                    Set activityRange = .Range("B10:B" & lastActivityRow)
                    ' 复制活动列表到Index表的B列，从当前行开始
                    activityRange.Copy
                    indexWs.Cells(currentRow, 2).PasteSpecial Paste:=xlPasteValues
                    ' 更新currentRow到活动列表的下一行
                    currentRow = currentRow + activityRange.Rows.Count
                Else
                    ' 如果没有活动，直接换行
                    currentRow = currentRow + 1
                End If
            End With
        End If
    Next ws
    
    ' 清除剪贴板内容，避免残留
    Application.CutCopyMode = False
    ' 定位到Index表的表头
    indexWs.Range("A1").Select
End Sub

关键逻辑说明 #

• 统一行跟踪：用currentRow变量全程跟踪Index表中当前要写入的行位置，解决原两段代码各行其是的问题
• 超链接添加：遍历每个工作表时，直接将超链接插入到A列的currentRow位置
• 活动列表获取：针对每个工作表，先定位B列（活动列）从B10开始的最后非空行，限制在B100范围内，复制有效值到Index表的B列对应位置
• 行位置更新：写完一个工作表的超链接和活动列表后，自动将currentRow更新为活动列表最后一行的下一行，确保下一个工作表名称自动衔接

内容的提问来源于stack exchange，提问作者Valerie Ho