为 Excel 工作表中的每个条目创建超链接，但仅在特定列中

Question

在附加的代码中，我正在遍历文件夹中的所有 Excel 文件并搜索关键字。然后我提取文件名、工作表编号、单元格编号和行数据，并将这些信息放入一个新创建的名为“摘要”的电子表格中。如何仅超链接工作表 # 和单元格 # 列（B 列和 C 列）以指向新创建的行条目来自的确切文件、页面、单元格？

这是我的代码的 sn-p：

 Sub SearchFolders()
'UpdatebySUPERtoolsforExcel2016
 ...
    Dim xOut As Worksheet
    Dim xWb As Workbook
    Dim xWk As Worksheet
    Dim xRow As Long
    Dim xFound As Range
    Dim xStrAddress As String
    Dim xCount As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a forlder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
  ...
    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set xOut = wsReport
    xRow = 1
    With xOut
        .Cells(xRow, 1) = "Workbook"
        .Cells(xRow, 2) = "Worksheet"
        .Cells(xRow, 3) = "Cell"
        .Cells(xRow, 4) = "Test"
        ...
        Set xFso = CreateObject("Scripting.FileSystemObject")
        Set xFld = xFso.GetFolder(xStrPath)
        xStrFile = Dir(xStrPath & "\*.xlsx")
        Do While xStrFile <> ""
            Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
            For Each xWk In xWb.Worksheets
                Set xFound = xWk.UsedRange.Find(xStrSearch, LookIn:=xlValues)
                If Not xFound Is Nothing Then
                    xStrAddress = xFound.Address
                End If
                Do
                    If xFound Is Nothing Then
                        Exit Do
                    Else

                    xCount = xCount + 1
                    xRow = xRow + 1
                    .Cells(xRow, 1) = xWb.Name
                    .Cells(xRow, 2) = xWk.Name
                    .Cells(xRow, 3) = xFound.Address
                     WriteDetails rCellwsReport, xFound

                    End If
                    Set xFound = xWk.Cells.FindNext(After:=xFound)
                Loop While xStrAddress <> xFound.Address
            Next
            xWb.Close (False)
            xStrFile = Dir
        Loop
        .Columns("A:I").EntireColumn.AutoFit
        .Range("A1:A" & xCount + 1).Rows.EntireRow.AutoFit
    End With

    MsgBox xCount & "cells have been found", , "SUPERtools for Excel"
ExitHandler:
    Set xOut = Nothing
    ...
    Application.ScreenUpdating = xUpdate
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Private Sub WriteDetails(ByRef xReceiver As Range, ByRef xDonor As Range)
  xReceiver.Value = xDonor.Parent.Name
  xReceiver.Offset(, 1).Value = xDonor.Address

  xDonor.EntireRow.Resize(, 100).Copy xReceiver.Offset(, 2)

  Set xReceiver = xReceiver.Offset(1)

End Sub

Answer 1

要创建指向external workbook/worksheet/cell 的超链接，您需要了解链接的形成方式

看这个例子

假设您在C:\ 中有一个文件Joe.Xlsx。假设它有一个名为 Sheet1 的工作表，并且您想超链接到该工作表的单元格 A1。

因此，在您当前的工作簿中，您将键入

=HYPERLINK("[C:\Joe.xlsx]Sheet1!A1","CLICK HERE")

所以如果你打破它，它会变成这样。

Dim FileName As String
Dim SheetName As String
Dim CellAddress As String

FileName = "C:\Joe.xlsx"
SheetName = "Sheet1"
CellAddress = "A1"

If InStr(1, SheetName, " ") Then SheetName = "'" & SheetName & "'"

Range("A1").Formula = "=HYPERLINK(" & Chr(34) & "[" & _
                      FileName & _
                      "]" & _
                      SheetName & _
                      "!" & _
                      CellAddress & _
                      Chr(34) & "," & Chr(34) & _
                      "CLICK HERE" & Chr(34) & ")"

只需在代码中循环使用它并创建超链接