获取Excel VBA中特定单元格超链接地址

Question

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

我正在处理工作簿的第二张表（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？

- user3682866

---

Range("A1").Hyperlinks(1).Address 将会获取到 A1 单元格中的第一个超链接。sheet1.range("AD32").Hyperlinks(1).Address 将会给你 AD32 单元格中的第一个超链接。 - Jzz

所以基本上你在问如何循环行？尝试在谷歌上搜索。如果有其他问题，请明确你的问题。 - Jzz

不，我会再试一次。列“J”中的单元格包含列“AD”中超链接的URL/地址的文本版本。例如，单元格“J23”包含单元格“AD23”中超链接的URL/地址。现在，列“J”中有空白单元格，即尚未具有列“AD”中超链接文本版本的单元格。我正在尝试循环遍历列“J”中的每个空白单元格，查看其“AD”列，提取该超链接的URL/地址，并将其放置到其“J”列的单元格中。这是我的代码。我想知道是否有类似于sheet1.range("AD23").Hyperlinks.Address的代码。 - user3682866

我的代码基本上是在执行 Sheet2.Range("AD23").Hyperlinks(1).Address，然后是 Sheet2.Range("AD24").Hyperlinks(1).Address 和 Sheet2.Range("AD25").Hyperlinks(1).Address，但它们都输出了 "AD23" 的超链接地址。 - user3682866

除非您正在向J列添加数据（并且该列中没有间隙），否则此行“NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address”每次都会返回相同的行。 - Rory

Answer 1

不确定为什么我们要大惊小怪，代码非常简单。

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

- JoeG

Answer 2

这应该可以正常工作：

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"将有所帮助。

- Jason K.

Answer 3

我认为这应该是一个返回字符串的函数，就像这样。

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

- FreeSoftwareServers

Answer 4

尝试按照以下方式运行for循环：

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

- abhinov

---

在这种情况下，lnk是一个范围类型的单元格，而不是超链接。 - Jason K.

不，如果您仔细观察，它是一个超链接。Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks是给定范围内的超链接集合。 - abhinov

Answer 5

从评论中我理解到您已经将列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

- D Mason