Excel VBA获取特定单元格的超链接地址答案

【问题标题】：Excel VBA Get hyperlink address of specific cellExcel VBA获取特定单元格的超链接地址
【发布时间】：2014-07-21 23:35:51
【问题描述】：

如何编写 Excel VBA 代码以检索特定单元格中超链接的 url/地址？

我正在处理我的工作簿的 sheet2，它包含大约 300 行。每行在“AD”列都有一个唯一的超链接。我想要做的是循环“J”列中的每个空白单元格，并将其值从空白更改为“AD”列单元格的超链接 URL。我目前正在使用此代码：

do while....
    NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
    On Error Resume Next
    GetAddress = Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks(1).Address
    On Error GoTo 0
loop

上面代码的问题是它总是得到第一个超链接的地址，因为代码是.Hyperlinks(1).Address。有没有办法通过范围地址获取超链接地址，比如sheet1.range("AD32").Hyperlinks.Address？

【问题讨论】：

Range("A1").Hyperlinks(1).Address 将为您提供单元格 A1 中的第一个超链接。 sheet1.range("AD32").Hyperlinks(1).Address 将为您提供单元格 AD32 中的第一个超链接
谢谢 Jzz，但是如果您查看我上面的代码，它应该会更改行，因此 GetAddress 应该会更改，但它始终返回它检测到的第一个链接的超链接地址。我忘了提到这段代码被包裹在一个 do while 循环中。我将编辑帖子。
所以基本上你问如何循环行？尝试谷歌。如果还有其他问题，请澄清您的问题。
不，我会再试一次。 “J”列中的单元格包含“AD”列单元格中超链接的 URL/地址的文本版本。像单元格“J23”包含单元格“AD23”中超链接的 URL/地址。现在，“J”列中有空白单元格，“AD”列中还没有超链接的文本版本。我正在尝试遍历“J”列中的每个空白单元格，查看它的“AD”列，提取该超链接的 url/地址并将其放置到“J”列中的单元格中。这是我上面的代码。我想知道是否有这样的代码 sheet1.range("AD23").Hyperlinks.Address
我的代码基本上是在做一个Sheet2.Range("AD23").Hyperlinks(1).Address，然后是一个Sheet2.Range("AD24").Hyperlinks(1).Address和一个Sheet2.Range("AD25").Hyperlinks(1).Address，但它们都输出了“AD23”的超链接地址

标签： vba excel hyperlink

【解决方案1】：

我从 cmets 的理解是，您已经将 J 列设置为 URL 字符串。如果是这样，这个简单的脚本应该可以完成这项工作（它将单元格超链接到单元格内指定的地址，如果您愿意，可以通过更改 textToDisplay 选项来更改单元格文本）。如果我误解了这一点并且字符串在 AD 列中，只需计算 AD 的列号并替换以下行：

fileLink = Cells(i, the number of column AD)

脚本：

Sub AddHyperlink()

Dim fileLink As String

Application.ScreenUpdating = False

With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row


For i = 4 To lastrow

    fileLink = Cells(i, 10)

    .Hyperlinks.Add Anchor:=Cells(i, 10), _
    Address:=fileLink, _
    TextToDisplay:=fileLink

Next i

End With

Application.ScreenUpdating = True

End Sub

【讨论】：

【解决方案2】：

尝试为每个循环运行如下：

do while....
    NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
    On Error Resume Next
    **for each** lnk in Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks
         GetAddress=lnk.Address
    next
On Error GoTo 0
loop

【讨论】：

在这种情况下，lnk 是范围类型的单元格，而不是超链接。
如果您仔细观察，它不是超链接。Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks，来自给定 Range 的超链接集合

【解决方案3】：

这应该可行：

Dim r As Long, h As Hyperlink
For r = 1 To Range("AD1").End(xlDown).Row
    For Each h In ActiveSheet.Hyperlinks
        If Cells(r, "AD").Address = h.Range.Address Then
            Cells(r, "J") = h.Address
        End If
    Next h
Next r

这有点令人困惑，因为 Range.Address 与 Hyperlink.Address（这是您的 URL）完全不同，声明您的类型将有很大帮助。这是另一种将“Option Explicit”放在模块顶部会有所帮助的情况。

【讨论】：

【解决方案4】：

不知道我们为什么大做文章，代码很简单

Sub ExtractURL()
    Dim GetURL As String
    For i = 3 To 500
        If IsEmpty(Cells(i, 1)) = False Then
            Sheets("Sheet2").Range("D" & i).Value = 
               Sheets("Sheet2").Range("A" & i).Hyperlinks(1).Address
        End If
    Next i
End Sub

【讨论】：

【解决方案5】：

这个 IMO 应该是一个像这样返回字符串的函数。

Public Sub TestHyperLink()
 Dim CellRng As Range
 Set CellRng = Range("B3")
 
 Dim HyperLinkURLStr As String
 HyperLinkURLStr = HyperLinkURLFromCell(CellRng)
 Debug.Print HyperLinkURLStr
End Sub

Public Function HyperLinkURLFromCell(CellRng As Range) As String
 HyperLinkURLFromCell = CStr(CellRng.Hyperlinks(1).Address)
End Function

【讨论】：