结合超链接和循环 VBA

Question

我有一个包含大约 30 个工作表的工作簿。我必须 link 从一张纸到另一张纸的文本如果我手动做它会花很多时间所以我想使用循环 hyperlink

Sub Macro4()
'
' Macro4 Macro

    Dim i As Integer
    Dim sht As Worksheet
    
    
    
    i = 2
    
    Set sht = Sheets("sheet" & i)
    Range("D3").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "sheet2!A1", TextToDisplay:=Range("D3").Value
End Sub

如何调整这条线我在哪里可以输入我的 I VARIABLE

子地址：= _ "sheet2!A1

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "sheet2!A1", TextToDisplay:=Range("D" & i).Value

Answer 1

试试这个代码

Sub Test()
    Dim sht As Worksheet, i As Integer
    For i = 2 To 5
        Set sht = Sheets("Sheet" & i)
        ActiveSheet.Hyperlinks.Add Anchor:=sht.Range("D3"), Address:="", SubAddress:=sht.Name & "!A1", TextToDisplay:=sht.Range("D3").Value
    Next i
End Sub

Answer 2

创建指向工作表的超链接

在工作簿 (wb) 的指定工作表 (wsh, wshName) 中，以下将创建指向所有其他工作表的超链接列表，除了Exceptions.
超链接将在从指定行 (FirstRow) 开始的指定列 (hColumn) 中创建。
超链接将指向每个工作表 (ws) 中的相同单元格 (sAddr)，并将显示来自指定单元格 (ttDisplay) 的文本。
如果指定的单元格（ttDisplay）为空（blank或""），则不会创建超链接，而是指定字符串的组合（IfNot) 和工作表名称 (ws) 将改为 'displayed'，例如No Value (Sheet3).

代码

Option Explicit

Sub createHyperlinks()

    Const wshName As String = "Sheet2"
    Const FirstRow As Long = 1
    Const hColumn As Variant = "A"
    Const sAddr As String = "A1"
    Const ttDisplay As String = "D3"
    Const IfNot As String = "No Value"
    Dim Exceptions As Variant
    Exceptions = Array(wshName) ' add more?
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim wsH As Worksheet: Set wsH = wb.Worksheets(wshName)
    
    Dim i As Long: i = FirstRow
    Dim ws As Worksheet
    'wsH.Columns(hColumn).Clear ' Maybe instead of the following 'Clear' line.
    For Each ws In wb.Worksheets
        wsH.Cells(i, hColumn).Clear
        If IsError(Application.Match(ws.Name, Exceptions, 0)) _
          And IsError(Application.Match(ws.Index, Exceptions, 0)) Then
            If ws.Range(ttDisplay).Value <> "" Then
                wsH.Hyperlinks.Add Anchor:=wsH.Cells(i, hColumn), _
                                   Address:="", _
                                   SubAddress:=ws.Name & "!" & sAddr, _
                                   TextToDisplay:=ws.Range(ttDisplay).Value
            Else
                wsH.Cells(i, hColumn) = IfNot & " (" & ws.Name & ")"
            End If
            i = i + 1
        End If
    Next ws

End Sub

结合超链接和循环 VBA

COMBINE HYPERLINK AND LOOPING VBA

excel

vba

hyperlink

创建指向工作表的超链接