Добавление гиперссылок с VBA для создания вкладки «Пояснения»

Question

У меня есть таблица данных и вкладка объяснений. Поскольку некоторые поля ввода в таблице данных трудно понять, я хотел бы добавить гиперссылки (щелкните по имени столбца и перейдите в нужную ячейку на вкладке «Пояснения») для многих из них. Поэтому я создал вкладку «Пояснения», которая может иметь или не иметь совпадающее значение из таблицы данных.

Итак, я перебираю все заголовки столбцов на вкладке Calcs (таблица данных), затем ищу соответствующую строку на вкладке Info (пояснения), и, если есть совпадение, я хочу создать гиперссылку из Calcs заголовок вкладки к заголовку вкладки Информация.

Я получаю сообщение об ошибке «Ожидается: именованный параметр» в части кода добавления гиперссылок, приведенной ниже:

Sub AddLinks()
Dim LinkRow As Integer
Dim InfoTab As String
Dim LastCol As Integer

'Row on Calcs tab that column headings are in
LinkRow = 5

'Name of explanations/info tab
InfoTab = "Info"

'Find last column in calcs table
LastCol = Sheets("Calcs").Cells(LinkRow, Columns.Count).End(xlToLeft).Column

'Loop through calcs column, look for corresponding cell in explanations tab, if it isn't
'blank, then add it as a hyperlink
For i = 1 To LastCol
    For j = 1 To LastCol
        If Sheets("Calcs").Cells(LinkRow, i).Value = Sheets(InfoTab).Cells(j, 1).Value Then
        Sheets("Calcs").Cells(LinkRow, i).Hyperlinks.Add Anchor:=Range(Sheets(InfoTab).Cells(j, 2).Address), Address:="",
             SubAddress:="'" & InfoTab & "'" & _
             "!" & Cells(j, 2).Address
        End If
   Next j
Next i
End Sub

Answer 1

Я не получаю никаких ошибок при запуске вашего кода.Я бы разбил код на меньшие легкие для тестирования подпрограммы.

---

Sub AddLinks2()
    Const LinkRow As Long = 5
    Dim cell As Range, list As Collection
    Set list = getExplanations
    With ThisWorkbook.Worksheets("Calcs")
        For Each cell In .Range(.Cells(LinkRow, 1), .Cells(LinkRow, Columns.Count).End(xlToLeft))
            On Error Resume Next
            list.Item cell.Text
            If Err.Number = 0 Then AddHyperlink cell, list(cell.Text)
            On Error GoTo 0
        Next
    End With
End Sub

Function getExplanations() As Collection
    Const LinkRow As Long = 5
    Dim cell As Range, list As New Collection

    With ThisWorkbook.Worksheets("Info")
        For Each cell In .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
            On Error Resume Next
            list.Add cell, cell.Text
            On Error GoTo 0
        Next
    End With
    Set getExplanations = list
End Function

Sub AddHyperlink(Anchor As Range, Target As Range)
    Dim SubAddress As String
    SubAddress = Split(Target.Address(0, 0, xlA1, True), "]")(1)
    ActiveSheet.Hyperlinks.Add Anchor:=Anchor, Address:="", SubAddress:=SubAddress
End Sub