首页 > 解决方案 > 在具有特定列值的单元格上创建超链接

问题描述

目标:通过超链接将特定列的特定范围(例如范围 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"

标签: excelvba

解决方案


过程:

  1. 定义变量
  2. 初始化它们
  3. 循环遍历范围内的单元格
  4. 验证单元格是否不为空
  5. 相应地添加超链接

阅读评论并对其进行自定义以满足您的需求。

代码:

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

让我知道它是否有效


推荐阅读