Excel 在具有特定列值的单元格上创建超链接

目标：通过超链接将特定列中特定范围（例如范围B7:B47）上的所有单元格链接到另一个工作表中的单元格

每个区域/单元格的超链接地址更改50行

请求有关如何解决此问题的帮助-对糟糕的编码表示歉意：

Range("B7").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A3"
Range("B8").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A53"
Range("B9").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A103"
Range("B10").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A153"
Range("B11").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A203"
Range("B12").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A253"
Range("B13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A303"
Range("B14").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A353"
Range("B15").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A403"
Range("B16").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A453"
Range("B17").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A503"

过程：

定义变量

初始化它们

在范围内的单元格中循环

验证单元格是否为空

相应地添加超链接

阅读评论并根据您的需要进行定制

代码：

Option Explicit

Public Sub AddHyperlinks()

    Dim evalSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim evalRange As Range
    Dim evalCell As Range

    Dim targetStartRow As Long
    Dim targetRowInterval As Long
    Dim targetRow As Long

    ' Customize this part
    Set evalSheet = ThisWorkbook.Worksheets("Sheet1")
    Set targetSheet = ThisWorkbook.Worksheets("Screenshots1")

    Set evalRange = evalSheet.Range("B7:B47")

    targetStartRow = 3
    targetRowInterval = 50

    ' Set initial row
    targetRow = targetStartRow

    ' Loop through each cell in evaluated range
    For Each evalCell In evalRange.Cells

        ' Execute only if cell is not empty
        If evalCell.Value <> vbNullString Then

            ' Add the hyperlink to the evaluated cell
            evalSheet.Hyperlinks.Add Anchor:=evalCell, Address:="", SubAddress:=targetSheet.Name & "!A" & targetRow, TextToDisplay:="Link"

            ' Increment the hyperlink target row
            targetRow = targetRow + targetRowInterval

        End If

    Next evalCell

End Sub

选项显式
公共子添加超链接（）
将评估表设置为工作表
将目标工作表变暗为工作表
Dim evalRange As范围
变暗evalCell As范围
暗淡的目标开始变长
黯淡的目标和冬天一样长
暗淡的目标和长的一样
'自定义此部件
设置评估表=此工作簿。工作表（“表1”）
Set targetSheet=ThisWorkbook.Worksheets（“屏幕快照1”）
设置evalRange=evalSheet.Range（“B7:B47”）
targetStartRow=3
targetRowInterval=50
'设置初始行
targetRow=targetStartRow
'循环通过评估范围内的每个单元格
对于evalRange.Cells中的每个evalCell
'仅当单元格不为空时执行
如果evalCell.Value为vbNullString，则
'将超链接添加到计算的单元格
evalSheet.Hyperlinks.Add锚点：=evalCell，地址：=“”，子地址：=targetSheet.Name&“！A”&targetRow，TextToDisplay:=”链接”
'增加超链接目标行
targetRow=targetRow+targetRowInterval
如果结束
下一个评估单元
端接头

---

让我知道它是否有效

请告诉我们源是什么以及最终结果是什么源是Sheet1范围B7:B47-所有单元格都应填充值如果没有，则我要停止宏。例如，代码将检查从B7到B47的值。我预期的结果是，工作表1 B7将超链接到名为“屏幕快照1”的工作表，并链接到特定的Cel，即“A3”。然后，Sheet1 B8将超链接到屏幕快照1 A53单元，并显示在屏幕上