超实用Excel VBA工具箱3-创建动态目录

        工作中我们可能会经常使用一个工作簿，这个工作簿里有各种不同的工作表。我们需要煤炭在不同的工作表里处理不同的信息，这是我们可能为工作簿创建一个动态的工作表目录，通过点击不同目录中的链接跳转到我们需要的工作表。

 

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
    Dim sht As Worksheet
    Dim rng As Range
    Dim str As String
    Dim nRow As Long
    Dim i As Long
    With Sheets("目录")
        nRow = .Cells(Rows.Count, 1).End(xlUp).Row '计算目录表中当前的行数
        .Range("A2:D" & nRow + 1).Clear '将目录表中原有的数据清空,这里加1是为了防止如果目中表中没有数据时将误删表头
    End With
    For Each sht In ThisWorkbook.Sheets '循环所有工作表
        If sht.Name <> "目录" Then
            With sht
                Set rng = Sheets("目录").Cells(.Rows.Count, 1).End(xlUp) '定位目录表的最后一行
                rng.Offset(1, 0) = rng.Row '序号
                rng.Offset(1, 1) = sht.Name '工作表的名称
                '工作表链接
                .Hyperlinks.Add Anchor:=rng.Offset(1, 1), Address:="", SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name, ScreenTip:="单击打开：" & sht.Name
                For i = 1 To 3 '将工作表中内容的前三个单元格内容合并为一个字符串
                    str = str & sht.UsedRange.Cells(i).Text
                Next
                rng.Offset(1, 2) = str & "……" '内容
                rng.Offset(1, 3) = sht.UsedRange.Address(0, 0) '使用区域
            End With
        End If
    Next
Application.ScreenUpdating = True
End Sub