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更改为jLoop，将超链接代码移到已填充的范围之后

Answer 2

你可以用这个

Sub LinkToSheet()
Dim SheetName As String

Sheets(SheetName).Select
EndSub

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

超链接单元格到源表

2 个答案: