ソースシートへのハイパーリンクセル

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置き換えjLoopに1を変更し、一緒に

Answer 2

あなたはこの

Sub LinkToSheet() 
Dim SheetName As String 

Sheets(SheetName).Select 
EndSub 

を使用して、このサブを実行するためのボタンやa linkを挿入することができます。もちろん、 "SheetName"の値をパラメータ化する必要があります。