Excel VBA 获取特定单元格的超链接地址
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23984577/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA Get hyperlink address of specific cell
提问by user3682866
How do I code Excel VBA to retrieve the url/address of a hyperlink in a specific cell?
如何编写 Excel VBA 代码以检索特定单元格中超链接的 url/地址？
I am working on sheet2 of my workbook and it contains about 300 rows. Each rows have a unique hyperlink at column "AD". What I'm trying to go for is to loop on each blank cells in column "J" and change it's value from blank to the hyperlink URL of it's column "AD" cell. I am currently using this code:
我正在处理我的工作簿的 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
Problem with the above code is it always get the address of the first hyperlink because the code is .Hyperlinks(1).Address. Is there anyway to get the hyperlink address by range address like maybe sheet1.range("AD32").Hyperlinks.Address?
上面代码的问题是它总是获取第一个超链接的地址，因为代码是.Hyperlinks(1).Address. 无论如何，是否可以通过范围地址获取超链接地址sheet1.range("AD32").Hyperlinks.Address？
回答by Jason K.
This should work:
这应该有效：
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
It's a bit confusing because Range.Address is totally different than Hyperlink.Address (which is your URL), declaring your types will help a lot. This is another case where putting "Option Explicit" at the top of modules would help.
这有点令人困惑，因为 Range.Address 与 Hyperlink.Address（这是您的 URL）完全不同，声明您的类型会有很大帮助。这是将“Option Explicit”放在模块顶部会有所帮助的另一种情况。
回答by JoeG
Not sure why we make a big deal, the code is very simple
不知道为什么我们做大事，代码很简单
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
回答by D Mason
My understanding from the comments is that you already have set the column J to a string of the URL. If so this simple script should do the job (It will hyperlink the cell to the address specified inside the cell, You can change the cell text if you wish by changing the textToDisplay option). If i misunderstood this and the string is in column AD simply work out the column number for AD and replace the following line:
我从评论中了解到您已经将列 J 设置为 URL 字符串。如果是这样，这个简单的脚本应该可以完成这项工作（它将单元格超链接到单元格内指定的地址，如果您愿意，可以通过更改 textToDisplay 选项来更改单元格文本）。如果我误解了这一点并且字符串在 AD 列中，只需计算 AD 的列号并替换以下行：
fileLink = Cells(i, the number of column AD)
The script:
剧本：
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
回答by abhinov
Try to run for each loop as below:
尝试为每个循环运行如下：
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
