将超链接单元格添加到源表单

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

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 

我想在列标签上创build一个超链接单元格。 所以我点击它应该带我到汇总表来源表。

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 

编辑：用MyIncolreplaceaCol，将1更改为jLoop，将范围填充后将超链接代码移至

Answer 2

你可以用这个

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

然后插入一个button或链接来运行此Sub。 当然，你必须参数化“SheetName”的值。