超链接单元格到源表

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

编辑：用myincol替换Acol，将1更改为JLOP，将超链接代码移至范围之后

Answer 2

您可以使用此

Sub LinkToSheet()
Dim SheetName As String
Sheets(SheetName).Select
EndSub

，然后插入一个按钮或链接以运行此子。当然，您必须参数" SheetName"的值。