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
让我知道它是否有效
推荐阅读
- node.js - 从另一个集合 mongoose 填充数据
- c++ - 向后打印对象指针向量的问题?
- c# - TryParse 预期会出现语法错误“,”
- javascript - 由于只在一个按钮上回复新帖子,“保存”?
- jquery - jquery防止拖动选择文本
- windows-server-2016 - ADFS farm when the primary instance is down, it doesn't automatically failover to the secondary instance
- google-sheets-api - 用电子表格的数据填充谷歌幻灯片的文本标签
- excel - 如何修复第二个 errHandler
- jenkins - 有条件地在不同的从站/工作区上运行 jenkins 阶段,否则使用现有的从站/工作区
- php - 在 Woocommerce 客户退款订单通知中获取退款原因