结合超链接和循环VBA

Question

我有一个包含大约30个工作表的工作簿。我必须将文本从一张纸链接到另一张纸如果我手动操作，会花费很多时间所以我想使用循环超链接

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

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

子地址：=_"sheet2！A1

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

Answer 1

创建指向工作表的超链接

• 在工作簿(wb(的指定工作表(wsh、wshName(中，以下操作将创建指向除Exceptions中的工作表之外的所有其他工作表的超链接列表
• 超链接将在从指定行(FirstRow(开始的指定列(hColumn(中创建
• 超链接将指向每个工作表(ws(中的同一单元格(sAddr(，并将显示指定单元格中的文本(ttDisplay(
• 如果指定的单元格(ttDisplay(为空(blank或""(，则不会创建超链接，而是"显示"指定字符串(IfNot(和工作表名称(ws(的组合，例如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

Answer 2

试试这个代码

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