嗨,我想找到一种方法来追溯引用单元格的超链接。例如:A 列中有 5 个随机单元格通过超链接引用 D2 单元格。所以当我去 D2 时,我怎么知道引用 D2 的单元格是什么。
非常感谢您的回答。
谢谢。
嗨,我想找到一种方法来追溯引用单元格的超链接。例如:A 列中有 5 个随机单元格通过超链接引用 D2 单元格。所以当我去 D2 时,我怎么知道引用 D2 的单元格是什么。
非常感谢您的回答。
谢谢。
A
一个工作表的列中,尝试找到链接到D2
另一个工作表上的单元格的单元格,并将找到的单元格的地址写入立即窗口。编码
Option Explicit
Sub detectHyperlinks()
' Source
Const srcName As String = "Sheet1"
Const srcFirst As String = "A1"
' Destination
Const dstName As String = "Sheet2"
Const dCellAddress As String = "D2"
' Define Source Column Range.
With ThisWorkbook.Worksheets(srcName)
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, .Range(srcFirst).Column).End(xlUp).Row
Dim rng As Range
Set rng = .Range(cFirst).Resize(LastRow - .Range(cFirst).Row + 1)
End With
' Define Destination Address String.
Dim dAddr As String
dAddr = dstName & "!" & dCellAddress
Dim cel As Range ' Current Cell in Source Range
Dim sAddr As String ' Source Address String
' Iterate through cells in Source Column Range.
For Each cel In rng.Cells
' Evaluate if current cell does not contain an error or blank value.
If Not IsError(cel) And Not IsEmpty(cel.Value) Then
' Evaluate if current cell contains a hyperlink.
If cel.Hyperlinks.Count > 0 Then
' Write current cells Sub Address to Source Address String
' and remove the "'" and "$" characters.
sAddr = Replace(cel.Hyperlinks(1).SubAddress, "'", "")
sAddr = Replace(sAddr, "$", "")
' Allowing different case (vbTextCompare), evaluate
' if Source and Destination Address Strings are equal.
If StrComp(sAddr, dAddr, vbTextCompare) = 0 Then
' Do what you need to do with the found cell.
' For example print its address to the Immdediate window.
Debug.Print cel.Address
End If
End If
End If
Next cel
End Sub