指向源工作表的超链接单元格

Question

下面的代码将创建一个合并表。我需要一个可以路由到源工作表的超链接单元格值。请找到以下代码。

Sub Collect()
    Dim myInSht As Worksheet
    Dim myOutSht As Worksheet
    Dim aRow As Range
    Dim aCol As Range
    Dim myInCol As Range
    Dim myOutCol As Range
    Dim calcState As Long
    Dim scrUpdateState As Long
    Dim cell As Range
    Dim iLoop As Long, jLoop As Long

    jLoop = 2

' loop through the worksheets
    For Each myInSht In ActiveWorkbook.Worksheets
' pick only the worksheets of interest
        'If myInSht.Name = "a" Or myInSht.Name = "aa" Or myInSht.Name = "aaa" Then
        ' find the columns of interest in the worksheet
            For Each aCol In myInSht.UsedRange.Columns
                Set myOutCol = Nothing
                If aCol.Cells(1, 1).Value = "timestamp" Then Set myOutCol = Sheets("Summary").Range("B2:B1000")
                If aCol.Cells(1, 1).Value = "ip" Then Set myOutCol = Sheets("Summary").Range("C2:C1000")
                If aCol.Cells(1, 1).Value = "protocol" Then Set myOutCol = Sheets("Summary").Range("D2:D1000")
                If aCol.Cells(1, 1).Value = "port" Then Set myOutCol = Sheets("Summary").Range("E2:E1000")
                If aCol.Cells(1, 1).Value = "hostname" Then Set myOutCol = Sheets("Summary").Range("F2:F1000")
                If aCol.Cells(1, 1).Value = "tag" Then Set myOutCol = Sheets("Summary").Range("G2:G1000")
                If aCol.Cells(1, 1).Value = "asn" Then Set myOutCol = Sheets("Summary").Range("I2:I1000")
                If aCol.Cells(1, 1).Value = "geo" Then Set myOutCol = Sheets("Summary").Range("J2:J1000")
                If aCol.Cells(1, 1).Value = "region" Then Set myOutCol = Sheets("Summary").Range("K2:K1000")
                If aCol.Cells(1, 1).Value = "naics" Then Set myOutCol = Sheets("Summary").Range("L2:L1000")
                If aCol.Cells(1, 1).Value = "sic" Then Set myOutCol = Sheets("Summary").Range("M2:M1000")
                If aCol.Cells(1, 1).Value = "server_name" Then Set myOutCol = Sheets("Summary").Range("H2:H1000")

                If Not myOutCol Is Nothing Then
' don't move the top line, it contains the headers - no data
                    Set myInCol = aCol
                    Set myInCol = myInCol.Offset(1, 0).Resize(myInCol.Rows.Count, myInCol.Columns.Count)
' transfer data from the project tab to the consolidated tab
                    iLoop = jLoop
                    For Each aRow In myInCol.Rows
                        myOutCol.Cells(iLoop, 1).Value = aRow.Cells(1, 1).Value
                        iLoop = iLoop + 1
                    Next aRow
                End If
            Next aCol
            'End If
        If iLoop > jLoop Then jLoop = iLoop
    Next myInSht
    End Sub

我想在列标签上创建一个超链接单元格。所以我点击它应该把我带到摘要表中的源表。

Answer 1

我对超链接很生疏，所以这看起来有点笨拙，但下面的代码应该会为您指明正确的方向。

If Not MyOutCol Is Nothing Then
    ' don't move the top line, it contains the headers - no data
    Set MyInCol = aCol
    Set MyInCol = MyInCol.Offset(1, 0).Resize(MyInCol.Rows.Count, MyInCol.Columns.Count)
    ' transfer data from the project tab to the consolidated tab
    iLoop = jLoop
    For Each aRow In MyInCol.Rows
        MyOutCol.Cells(iLoop, 1).Value = aRow.Cells(1, 1).Value
        iLoop = iLoop + 1
    Next aRow

    MyOutCol.Parent.Hyperlinks.Add _
        Anchor:=MyOutCol.Cells(jLoop, 1), _
        Address:="", _
        SubAddress:=MyInCol.Parent.Name & "!" & MyInCol.Address, _
        TextToDisplay:=MyInCol.Cells(1, 1).Value

End If

编辑：将 aCol 替换为 MyIncol，将 1 更改为 jLoop，将超链接代码移至填充范围后

Answer 2

你可以用这个

Sub LinkToSheet()
Dim SheetName As String

Sheets(SheetName).Select
EndSub

然后插入一个按钮或a link 来运行这个Sub。当然，您必须参数化“SheetName”的值。